home *** CD-ROM | disk | FTP | other *** search
/ ETO Development Tools 2 / ETO Development Tools 2.iso / Tools - Objects / MacApp / MacApp CD Release / MacApp 2.0.1 (Many Libraries) / Libraries / UMacApp.TApplication.p < prev    next >
Encoding:
Text File  |  1990-10-25  |  115.5 KB  |  4,462 lines  |  [TEXT/MPS ]

  1. {$P}
  2. {[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
  3. { UMacApp.TApplication.p }
  4. { Copyright © 1984-1990 by Apple Computer Inc. All rights reserved. }
  5.  
  6. {--------------------------------------------------------------------------------------------------}
  7. {$S MAApplicationRes}
  8.  
  9. FUNCTION TCommandList.Compare(item1, item2: TObject): integer;
  10.  
  11.     BEGIN
  12.     IF TCommand(item1).fPriority > TCommand(item2).fPriority THEN
  13.         Compare := kItem1GreaterThanItem2
  14.     ELSE IF TCommand(item1).fPriority < TCommand(item2).fPriority THEN
  15.         Compare := kItem1LessThanItem2
  16.     ELSE
  17.         Compare := kItem1EqualItem2
  18.     END;
  19.  
  20. {--------------------------------------------------------------------------------------------------}
  21. {$S MAInit}
  22.  
  23. PROCEDURE TCommandList.ICommandList;
  24.  
  25.     BEGIN
  26.     ISortedList;
  27.     END;
  28.  
  29. {--------------------------------------------------------------------------------------------------}
  30. {$S MAApplicationRes}
  31.  
  32. PROCEDURE TCommandList.Insert(item: TObject); OVERRIDE;
  33.  
  34.     VAR
  35.         oldObjectPerm: BOOLEAN;
  36.         anEqualItem: ArrayIndex;
  37.         lastEqualItem: ArrayIndex;
  38.         i: ArrayIndex;
  39.  
  40.     BEGIN
  41.     { Guarantee that the insertion can take place }
  42.     oldObjectPerm := AllocateObjectsFromPerm(FALSE);
  43.  
  44.     { !!! the search alg. should support this.  Performance will degrade here for
  45.     big queues (shouldn't happen often, but come back and fix the general case anyways) }
  46.  
  47.     anEqualItem := GetEqualItemNo(item);
  48.  
  49.     { If any equal items were found then find the _last_ equal item }
  50.     IF anEqualItem <> kEmptyIndex THEN
  51.         BEGIN
  52.         lastEqualItem := anEqualItem; { Tentative value }
  53.         FOR i := (anEqualItem + 1) TO GetSize DO    { ??? what about kMaxArrayIndex? }
  54.             IF Compare(At(i), item) = kItem1EqualItem2 THEN
  55.                 lastEqualItem := i
  56.             ELSE
  57.                 LEAVE;
  58.  
  59.         InsertBefore(lastEqualItem + 1, item);
  60.         END
  61.     ELSE
  62.         INHERITED Insert(item);
  63.  
  64.     IF AllocateObjectsFromPerm(oldObjectPerm) THEN;
  65.     END;
  66.  
  67. {--------------------------------------------------------------------------------------------------}
  68. {$S MAFields}
  69.  
  70. PROCEDURE TCommandList.Fields(PROCEDURE DoToField(fieldName: Str255;
  71.                                                   fieldAddr: Ptr;
  72.                                                   fieldType: integer)); OVERRIDE;
  73.  
  74.     BEGIN
  75.     DoToField('TCommandList', NIL, bClass);
  76.     INHERITED Fields(DoToField);
  77.     END;
  78.  
  79. {--------------------------------------------------------------------------------------------------}
  80. {$IFC qDebug}
  81. {$S MADebugger}
  82.  
  83. PROCEDURE TDebugCommand.DoIt;
  84.  
  85.     BEGIN
  86.     EnterMacAppDebugger;
  87.     END;
  88. {$ENDC}
  89.  
  90. {--------------------------------------------------------------------------------------------------}
  91. {$IFC qDebug}
  92. {$S MASelCommand}
  93.  
  94. PROCEDURE TDebugCommand.IDebugCommand(itsCmdNumber: CmdNumber);
  95.  
  96.     BEGIN
  97.     INoChangesCommand(itsCmdNumber, NIL, NIL, NIL);
  98.     END;
  99. {$ENDC}
  100.  
  101. {--------------------------------------------------------------------------------------------------}
  102. {$IFC qDebug}
  103. {$S MAFields}
  104.  
  105. PROCEDURE TDebugCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
  106.                                                    fieldAddr: Ptr;
  107.                                                    fieldType: integer)); OVERRIDE;
  108.  
  109.     BEGIN
  110.     DoToField('TDebugCommand', NIL, bClass);
  111.     INHERITED Fields(DoToField);
  112.     END;
  113. {$ENDC}
  114.  
  115. {--------------------------------------------------------------------------------------------------}
  116. {$IFC qInspector}
  117. {$S MAInspector}
  118.  
  119. PROCEDURE TInspectorCommand.DoIt;
  120.  
  121.     BEGIN
  122.     MakeInspectorWindow;
  123.     END;
  124. {$ENDC}
  125.  
  126. {--------------------------------------------------------------------------------------------------}
  127. {$IFC qInspector}
  128. {$S MASelCommand}
  129.  
  130. PROCEDURE TInspectorCommand.IInspectorCommand(itsCmdNumber: CmdNumber);
  131.  
  132.     BEGIN
  133.     INoChangesCommand(itsCmdNumber, NIL, NIL, NIL);
  134.     END;
  135. {$ENDC}
  136.  
  137. {--------------------------------------------------------------------------------------------------}
  138. {$IFC qInspector}
  139. {$S MAFields}
  140.  
  141. PROCEDURE TInspectorCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
  142.                                                        fieldAddr: Ptr;
  143.                                                        fieldType: integer)); OVERRIDE;
  144.  
  145.     BEGIN
  146.     DoToField('TInspectorCommand', NIL, bClass);
  147.     INHERITED Fields(DoToField);
  148.     END;
  149. {$ENDC}
  150.  
  151. {--------------------------------------------------------------------------------------------------}
  152. {$S MAApplicationRes}
  153.  
  154. PROCEDURE TQuitCommand.DoIt;
  155.  
  156.     VAR
  157.         fi:                 FailInfo;
  158.  
  159.     PROCEDURE HdlQuit(error: OSErr;
  160.                       message: LONGINT);
  161.  
  162.         BEGIN
  163.         gAppDone := FALSE;
  164.         END;
  165.  
  166.     BEGIN
  167.     CatchFailures(fi, HdlQuit);
  168.     gAppDone := TRUE;
  169.     gApplication.Close;
  170.     Success(fi);
  171.     END;
  172.  
  173. {--------------------------------------------------------------------------------------------------}
  174. {$S MAInit}
  175.  
  176. PROCEDURE TQuitCommand.IQuitCommand(itsCmdNumber: CmdNumber);
  177.  
  178.     BEGIN
  179.     INoChangesCommand(itsCmdNumber, NIL, NIL, NIL);
  180.     END;
  181.  
  182. {--------------------------------------------------------------------------------------------------}
  183. {$S MAFields}
  184.  
  185. PROCEDURE TQuitCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
  186.                                                   fieldAddr: Ptr;
  187.                                                   fieldType: integer)); OVERRIDE;
  188.  
  189.     BEGIN
  190.     DoToField('TQuitCommand', NIL, bClass);
  191.     INHERITED Fields(DoToField);
  192.     END;
  193.  
  194. {--------------------------------------------------------------------------------------------------}
  195. {$S MAApplicationRes}
  196.  
  197. PROCEDURE TUndoRedoCommand.DoIt;
  198.  
  199.     VAR
  200.         deltaCount:         integer;
  201.         lastCommand:        TCommand;
  202.  
  203.     BEGIN
  204.     lastCommand := gTarget.GetLastCommand;
  205.     IF lastCommand.fChangesClipboard THEN
  206.         gApplication.SwapClipViews;
  207.  
  208.     IF lastCommand.fCmdDone THEN
  209.         BEGIN
  210.         lastCommand.UndoIt;
  211.         deltaCount := - 1;
  212.         END
  213.     ELSE
  214.         BEGIN
  215.         lastCommand.RedoIt;
  216.         deltaCount := 1;
  217.         END;
  218.  
  219.     lastCommand.fCmdDone := NOT lastCommand.fCmdDone;
  220.  
  221.     IF lastCommand.fCausesChange THEN                    { put this after .UndoIt/.RedoIt, so they
  222.                                                          can change the flag }
  223.         WITH lastCommand DO
  224.             IF fChangedDocument <> NIL THEN
  225.                 WITH fChangedDocument DO
  226.                     BEGIN
  227.                     SetChangeCount(GetChangeCount + deltaCount);
  228.                     {$IFC qDebug}
  229.                     IF GetChangeCount < 0 THEN
  230.                         ProgramBreak('GetChangeCount < 0');
  231.                     {$ENDC}
  232.                     END;
  233.     END;
  234.  
  235. {--------------------------------------------------------------------------------------------------}
  236. {$S MAInit}
  237.  
  238. PROCEDURE TUndoRedoCommand.IUndoRedoCommand(itsCmdNumber: CmdNumber);
  239.  
  240.     BEGIN
  241.     INoChangesCommand(itsCmdNumber, NIL, NIL, NIL);
  242.     END;
  243.  
  244. {--------------------------------------------------------------------------------------------------}
  245. {$S MAFields}
  246.  
  247. PROCEDURE TUndoRedoCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
  248.                                                       fieldAddr: Ptr;
  249.                                                       fieldType: integer)); OVERRIDE;
  250.  
  251.     BEGIN
  252.     DoToField('TUndoRedoCommand', NIL, bClass);
  253.     INHERITED Fields(DoToField);
  254.     END;
  255.  
  256. {--------------------------------------------------------------------------------------------------}
  257. {$S MAOpen}
  258.  
  259. PROCEDURE TNewDocCommand.DoIt;
  260.  
  261.     BEGIN
  262.     gApplication.OpenNew(fCmdNumber);
  263.     END;
  264.  
  265. {--------------------------------------------------------------------------------------------------}
  266. {$S MASelCommand}
  267.  
  268. PROCEDURE TNewDocCommand.INewDocCommand(itsCmdNumber: CmdNumber);
  269.  
  270.     BEGIN
  271.     INoChangesCommand(itsCmdNumber, NIL, NIL, NIL);
  272.     END;
  273.  
  274. {--------------------------------------------------------------------------------------------------}
  275. {$S MAFields}
  276.  
  277. PROCEDURE TNewDocCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
  278.                                                     fieldAddr: Ptr;
  279.                                                     fieldType: integer)); OVERRIDE;
  280.  
  281.     BEGIN
  282.     DoToField('TNewDocCommand', NIL, bClass);
  283.     INHERITED Fields(DoToField);
  284.     END;
  285.  
  286. {--------------------------------------------------------------------------------------------------}
  287. {$S MAOpen}
  288.  
  289. PROCEDURE TOldDocCommand.DoIt;
  290.  
  291.     VAR
  292.         anAppFile:            AppFile;
  293.  
  294.     BEGIN
  295.     IF gApplication.ChooseDocument(fCmdNumber, anAppFile) THEN
  296.         gApplication.OpenOld(fCmdNumber, anAppFile);
  297.     END;
  298.  
  299. {--------------------------------------------------------------------------------------------------}
  300. {$S MASelCommand}
  301.  
  302. PROCEDURE TOldDocCommand.IOldDocCommand(itsCmdNumber: CmdNumber);
  303.  
  304.     BEGIN
  305.     INoChangesCommand(itsCmdNumber, NIL, NIL, NIL);
  306.     END;
  307.  
  308. {--------------------------------------------------------------------------------------------------}
  309. {$S MAFields}
  310.  
  311. PROCEDURE TOldDocCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
  312.                                                     fieldAddr: Ptr;
  313.                                                     fieldType: integer)); OVERRIDE;
  314.  
  315.     BEGIN
  316.     DoToField('TOldDocCommand', NIL, bClass);
  317.     INHERITED Fields(DoToField);
  318.     END;
  319.  
  320. {--------------------------------------------------------------------------------------------------}
  321. {$S MASelCommand}
  322.  
  323. PROCEDURE TAboutAppCommand.IAboutAppCommand(itsCmdNumber: CmdNumber);
  324.  
  325.     BEGIN
  326.     INoChangesCommand(itsCmdNumber, NIL, NIL, NIL);
  327.     END;
  328.  
  329. {--------------------------------------------------------------------------------------------------}
  330. {$S MAAboutApp}
  331.  
  332. PROCEDURE TAboutAppCommand.DoIt;
  333.  
  334.     BEGIN
  335.     gApplication.DoShowAboutApp;
  336.     END;
  337.  
  338. {--------------------------------------------------------------------------------------------------}
  339. {$S MAFields}
  340.  
  341. PROCEDURE TAboutAppCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
  342.                                                       fieldAddr: Ptr;
  343.                                                       fieldType: integer)); OVERRIDE;
  344.  
  345.     BEGIN
  346.     DoToField('TAboutAppCommand', NIL, bClass);
  347.     INHERITED Fields(DoToField);
  348.     END;
  349.  
  350. {--------------------------------------------------------------------------------------------------}
  351. {$S MAInit}
  352.  
  353. PROCEDURE TApplication.IApplication(itsMainFileType: OSType);
  354.  
  355.     CONST
  356.         kParamText1         = '^0';
  357.  
  358.     TYPE
  359.         MenuBarHandle        = ^MenuBarPtr;
  360.         MenuBarPtr            = ^MenuBarRecord;
  361.         MenuBarRecord        = RECORD
  362.             nMenus:             integer;
  363.             menuID:             ARRAY [1..1000] OF integer;
  364.             END;
  365.  
  366.     VAR
  367.         menuID:             integer;
  368.         aMenu:                MenuHandle;
  369.         mbar:                Handle;
  370.         hmbar:                MenuBarHandle;
  371.         i:                    integer;
  372.         s:                    Str255;
  373.         aCommandList:        TCommandList;
  374.         apName:             Str255;
  375.         apRefnum:            integer;
  376.         apParam:            Handle;
  377.  
  378.     BEGIN
  379.     gApplication := SELF;
  380.     gAppDone := FALSE;
  381.     gSysWindowActive := FALSE;
  382.     gTarget := SELF;
  383.     fTicksOfLastIdle := 0;
  384.     fTicksTilNextIdle := 0;
  385.     fCommandQueue := NIL;
  386.     fLastCommand := NIL;
  387.  
  388.     WITH gOldScrapStuff DO
  389.         BEGIN
  390.         scrapSize := 0;
  391.         scrapHandle := NIL;
  392.         scrapCount := 0;
  393.         scrapState := 0;
  394.         scrapName := NIL;
  395.         END;
  396.     gNewScrapStuff := gOldScrapStuff;
  397.  
  398.     IEvtHandler(NIL);
  399.  
  400.     {$IFC qInspector}
  401.     MakeInspector;
  402.     AddObjectToInspector(SELF);
  403.     AddObjectToInspector(gNullPrintHandler);
  404.     AddObjectToInspector(gPrintHandler);
  405.     AddObjectToInspector(gFreeWindowList);
  406.     {$ENDC}
  407.  
  408.     New(aCommandList);
  409.     FailNil(aCommandList);
  410.     aCommandList.ICommandList;
  411.     fCommandQueue := aCommandList;
  412.     {$IFC qDebug}
  413.     fCommandQueue.SetEltType('TCommand');
  414.     {$ENDC}
  415.  
  416.     fLaunchWithNewDocument := TRUE;
  417.  
  418.     gDocList := NewList;
  419.     {$IFC qDebug}
  420.     gDocList.SetEltType('TDocument');
  421.     {$ENDC}
  422.  
  423.     gMainFileType := itsMainFileType;
  424.  
  425.     gVarClipPicSize := FALSE;                            { temporary }
  426.  
  427.     IF NOT gFinderPrinting THEN
  428.         BEGIN
  429.         mbar := MAGetNewMBar(gMBarDisplayed);
  430.         IF mbar <> NIL THEN
  431.             BEGIN
  432.             SetMenuBar(mbar);
  433.             ReleaseResource(Handle(mbar));
  434.             END
  435.         ELSE
  436.             BEGIN
  437.             {$IFC qDebug}
  438.             Writeln('The MBAR ', gMBarDisplayed: 1, ' resource was not specified.');
  439.             ProgramBreak('You will not have any menus!');
  440.             {$ENDC}
  441.             END;
  442.  
  443.         {$IFC qDebug OR qInspector}
  444.         aMenu := GetMenu(mDebug);
  445.         IF aMenu <> NIL THEN
  446.             InsertMenu(aMenu, 0);
  447.         {$ENDC}
  448.  
  449.         aMenu := MAGetMenu(mApple);
  450.         IF aMenu <> NIL THEN
  451.             AddResMenu(aMenu, 'DRVR');
  452.  
  453.         { If the "About" item contains the paramtext keystring (^0) then substitute the
  454.         Application's name }
  455.         CmdToName(cAboutApp, s);
  456.         i := Pos(kParamText1, s);
  457.         IF i <> 0 THEN
  458.             BEGIN
  459.             GetAppParms(apName, apRefnum, apParam);
  460.             Delete(s, i, length(kParamText1));
  461.             Insert(apName, s, i);
  462.             SetCmdName(cAboutApp, s);
  463.             END;
  464.  
  465.         mbar := MAGetNewMBar(gMBarNotDisplayed);        { reads in and initializes these menus. }
  466.         IF mbar <> NIL THEN
  467.             ReleaseResource(Handle(mbar));
  468.  
  469.         IF qNeedsHierarchicalMenus | gConfiguration.hasHierarchicalMenus THEN
  470.             BEGIN
  471.             { Add all the hierarchical menus in the 'hierarchical' menu bar to the applications
  472.             menus.    Note that hierarchical must be treated differently from regular menus in that
  473.             they are added with InsertMenu(…, -1).    We can't use GetNewMBar here because we want
  474.             to call GetMenu for each menu in the MBAR, and GetNewMBar would do that for us.}
  475.             hmbar := MenuBarHandle(GetResource('MBAR', gMBarHierarchical));
  476.             IF hmbar <> NIL THEN
  477.                 BEGIN
  478.                 FOR i := 1 TO hmbar^^.nMenus DO
  479.                     BEGIN
  480.                     aMenu := GetMenu(hmbar^^.menuID[i]);
  481.                     IF aMenu <> NIL THEN
  482.                         InsertMenu(aMenu, - 1);
  483.                     END;
  484.                 ReleaseResource(Handle(hmbar));
  485.                 END;
  486.             END;
  487.  
  488.         InvalidateMenuBar;
  489.  
  490.         gClipWindow := MakeClipboardWindow;
  491.         gClipOrphanage := gClipWindow.FindSubView(KIDClipView);
  492.         FailNILResource(gClipOrphanage);
  493.  
  494.         END;
  495.  
  496.     {
  497.     | Finally finish up with the debugger;
  498.     }
  499.     {$IFC qDebug}
  500.     InitUDebugAfterIApplication;
  501.     {$ENDC}
  502.  
  503.     END;
  504.  
  505. {--------------------------------------------------------------------------------------------------}
  506. {$S MAClipboard}
  507.  
  508. PROCEDURE TApplication.AbandonUndoClipboard;
  509.  
  510.     BEGIN
  511.     IF gClipUndoView <> NIL THEN
  512.         BEGIN
  513.         {$IFC qDebug}
  514.         IF gClipUndoView = gClipView THEN
  515.             ProgramBreak('About to Free view both in clip and undo Clip!');
  516.         {$ENDC}
  517.         gClipUndoView.FreeFromClipboard;
  518.         gClipUndoView := NIL;
  519.         END;
  520.     END;
  521.  
  522. {--------------------------------------------------------------------------------------------------}
  523. {$S MAActivate}
  524.  
  525. PROCEDURE TApplication.AboutToLoseControl(convertClipboard: BOOLEAN);
  526.  
  527.     LABEL 1000;
  528.  
  529.     VAR
  530.         err:                LONGINT;
  531.         fi:                 FailInfo;
  532.         lastCommand:        TCommand;
  533.  
  534.     PROCEDURE PublicizeFailed(error: integer;
  535.                               message: LONGINT);        { ??? ERROR ??? }
  536.  
  537.         BEGIN
  538.         {$IFC qDebug}
  539.         Writeln('Can''t use clipboard data outside this app');
  540.         {$ENDC}
  541.         IF message = 0 THEN
  542.             message := msgExportClipFailed;
  543.         ShowError(error, message);
  544.         GOTO 1000;
  545.         END;
  546.  
  547.     BEGIN
  548.  { Remember when we last started a desk accessory. UPrinting uses this
  549.   to know whether the Chooser may have been run. }
  550.     gLastDeskAcc := TickCount;
  551.  
  552.     ActivateBusyCursor(FALSE);                            { Don't want busy cursor while in desk acc.}
  553.  
  554.     IF convertClipboard THEN
  555.         BEGIN
  556.         lastCommand := GetLastCommand;
  557.         IF (lastCommand <> NIL) & lastCommand.fChangesClipboard THEN
  558.             CommitLastCommand;
  559.  
  560.         IF (gClipView <> NIL) & (NOT gClipWrittenToDeskScrap) THEN
  561.             BEGIN
  562.             err := ZeroScrap;
  563.             CatchFailures(fi, PublicizeFailed);
  564.             gClipView.WriteToDeskScrap;
  565.             Success(fi);
  566.             gClipWrittenToDeskScrap := TRUE;
  567.         1000:
  568.             AbsorbScrapStuff;                            { ??? correct post-error reentry point? }
  569.             END;
  570.         END;
  571.     END;
  572.  
  573. {--------------------------------------------------------------------------------------------------}
  574. {$S MAApplicationRes}
  575.  
  576. PROCEDURE TApplication.AbsorbScrapStuff;
  577.  
  578.     BEGIN
  579.     gOldScrapStuff := gNewScrapStuff;                    { stash previous version, for later
  580.                                                          change-checkage }
  581.     gNewScrapStuff := InfoScrap^;                        { Copy over from low memory to our private
  582.                                                          global record }
  583.     END;
  584.  
  585. {--------------------------------------------------------------------------------------------------}
  586. {$S MAApplicationRes}
  587.  
  588. PROCEDURE TApplication.ActivateBusyCursor(entering: BOOLEAN);
  589.  
  590.     BEGIN
  591.     BusyActivate(entering);
  592.     END;
  593.  
  594. {--------------------------------------------------------------------------------------------------}
  595. {$S MAOpen}
  596.  
  597. PROCEDURE TApplication.AddDocument(aNewDocument: TDocument);
  598.  
  599.     BEGIN
  600.     gDocList.Insert(aNewDocument);
  601.     END;
  602.  
  603. {--------------------------------------------------------------------------------------------------}
  604. {$S MAOpen}
  605.  
  606. PROCEDURE TApplication.AddFreeWindow(aWindow: TWindow);
  607.  
  608.     BEGIN
  609.     gFreeWindowList.Insert(aWindow);
  610.     END;
  611.  
  612. {--------------------------------------------------------------------------------------------------}
  613. {$S MAFile}
  614.  
  615. FUNCTION TApplication.AlreadyOpen(fileName: Str255;
  616.                                   volRefnum: integer): TDocument;
  617.  
  618.     CONST
  619.         ignoreCase            = FALSE;
  620.         diacritSens         = TRUE;
  621.  
  622.     VAR
  623.         parmDirID:            LONGINT;
  624.         parmVRefnum:        integer;
  625.         result:             TDocument;
  626.         err:                OSErr;
  627.  
  628.     PROCEDURE TestDoc(doc: TDocument);
  629.  
  630.         VAR
  631.             err:                OSErr;
  632.             docVRefnum:         integer;
  633.             docDirID:            LONGINT;
  634.  
  635.         BEGIN
  636.         IF (result = NIL) & doc.fSaveExists THEN
  637.             BEGIN
  638.             docVRefnum := doc.fVolRefnum;
  639.             err := GetDirID(docVRefnum, docDirID);
  640.             IF (err = noErr) & (docVRefnum = parmVRefnum) & (docDirID = parmDirID) THEN
  641.                 BEGIN
  642.                 {$Push} {$H-}                            { EqualString does not move memory }
  643.                 IF EqualString(fileName, doc.fTitle^^, ignoreCase, diacritSens) THEN
  644.                     result := doc;
  645.                 {$Pop}
  646.                 END;
  647.             END;
  648.         END;
  649.  
  650.     BEGIN
  651.     result := NIL;
  652.  
  653.     parmVRefnum := volRefnum;
  654.     err := GetDirID(parmVRefnum, parmDirID);
  655.  
  656.     IF err = noErr THEN
  657.         ForAllDocumentsDo(TestDoc);
  658.  
  659.     AlreadyOpen := result;
  660.     END;
  661.  
  662. {--------------------------------------------------------------------------------------------------}
  663. {$S MAApplicationRes}
  664.  
  665. PROCEDURE TApplication.Beep(duration: integer);
  666.  
  667.     BEGIN
  668.     SysBeep(duration);
  669.     END;
  670.  
  671. {--------------------------------------------------------------------------------------------------}
  672.  
  673. FUNCTION CallFileFilter(paramBlock: HParmBlkPtr;
  674.                         routine: ProcPtr): BOOLEAN;
  675.     INLINE $205F,                                        { MOVEA.L (A7)+,A0 }
  676.            $4E90;                                        { JSR (A0) }
  677.  
  678.  { This is called only when opening/printing from the finder; it simulates the
  679.   filtering done by Std File. }
  680.  
  681. {--------------------------------------------------------------------------------------------------}
  682. {$S MAFinder}
  683.  
  684. FUNCTION TApplication.CanOpenDocument(itsCmdNumber: CmdNumber;
  685.                                       VAR anAppFile: AppFile): BOOLEAN;
  686.  
  687.     VAR
  688.         dlgID:                integer;
  689.         where:                Point;
  690.         fileFilter:         ProcPtr;
  691.         dlgHook:            ProcPtr;
  692.         filterProc:         ProcPtr;
  693.         typeList:            TypeListHandle;
  694.         i:                    integer;
  695.         paramBlock:         HParamBlockRec;
  696.         numTypes:            integer;
  697.  
  698.     BEGIN
  699.     CanOpenDocument := FALSE;
  700.  
  701.   { First check that file type is in the list of allowed file types. See SFGetParms
  702.    below for more info. }
  703.     typeList := TypeListHandle(NewHandle(0));
  704.     FailNil(typeList);
  705.  
  706.     SFGetParms(itsCmdNumber, dlgID, where, fileFilter, dlgHook, filterProc, typeList);
  707.  
  708.     numTypes := GetHandleSize(Handle(typeList)) DIV SIZEOF(ResType);
  709.     IF numTypes = 0 THEN
  710.         CanOpenDocument := TRUE                         { if 0 then want all types }
  711.     ELSE
  712.         FOR i := 1 TO numTypes DO
  713.  { do coercions because the compiler generates lousy code for comparing 2
  714.   packed arrays of characters }
  715.             IF LONGINT(anAppFile.fType) = LONGINT(typeList^^[i]) THEN
  716.                 BEGIN
  717.                 IF fileFilter = NIL THEN
  718.                     CanOpenDocument := TRUE
  719.                 ELSE IF GetFileInfo(anAppFile.fName, anAppFile.vRefnum, paramBlock) = noErr THEN
  720.                     CanOpenDocument := NOT CallFileFilter(@paramBlock, fileFilter)
  721.                 ELSE
  722.                     CanOpenDocument := FALSE;
  723.                 LEAVE;
  724.                 END;
  725.  
  726.     Handle(typeList) := DisposeIfHandle(typeList);
  727.     END;
  728.  
  729. {--------------------------------------------------------------------------------------------------}
  730. {$S MAApplicationRes}
  731.  
  732. PROCEDURE TApplication.CheckDeskScrap;
  733.  
  734.     VAR
  735.         err:                OSErr;
  736.         lastCommand:        TCommand;
  737.  
  738.     BEGIN
  739.     AbsorbScrapStuff;
  740.  
  741.     IF (gOldScrapStuff.scrapCount <> gNewScrapStuff.scrapCount) THEN
  742.         BEGIN
  743.         lastCommand := GetLastCommand;
  744.         IF (lastCommand <> NIL) & lastCommand.fChangesClipboard THEN
  745.             CommitLastCommand;
  746.         gClipView.FreeFromClipboard;                    { AbandonCurrentClipboard }
  747.         gClipView := NIL;                                { no reason to have an Undo clipboard }
  748.  
  749.         { If the scrap is in memory and we are low on memory, then write the scrap to disk.}
  750.         IF (gNewScrapStuff.scrapState > 0) & MemSpaceIsLow THEN
  751.             err := UnloadScrap;                         { Write the scrap to disk. How should we
  752.                                                          handle the error??? }
  753.         ReadFromDeskScrap;
  754.         END;
  755.     END;
  756.  
  757. {--------------------------------------------------------------------------------------------------}
  758. {$S MAOpen}
  759.  
  760. FUNCTION TApplication.ChooseDocument(itsCmdNumber: CmdNumber;
  761.                                      VAR anAppFile: AppFile): BOOLEAN;
  762.  
  763.     TYPE
  764.         SFTypeListHandle    = ^SFTypeListPtr;
  765.         SFTypeListPtr        = ^SFTypeList;
  766.  
  767.     VAR
  768.         dlgID:                integer;
  769.         where:                Point;
  770.         fileFilter:         ProcPtr;
  771.         dlgHook:            ProcPtr;
  772.         filterProc:         ProcPtr;
  773.         typeList:            TypeListHandle;
  774.         pTypeList:            SFTypeListPtr;
  775.         numTypes:            integer;
  776.         reply:                SFReply;
  777.  
  778.     BEGIN
  779.     typeList := TypeListHandle(NewHandle(0));
  780.     FailNil(typeList);
  781.  
  782.     SFGetParms(itsCmdNumber, dlgID, where, fileFilter, dlgHook, filterProc, typeList);
  783.     numTypes := GetHandleSize(Handle(typeList)) DIV SIZEOF(ResType);
  784.  
  785.     IF numTypes = 0 THEN
  786.         BEGIN
  787.         numTypes := - 1;                                { Tell Std File to display all types.}
  788.         pTypeList := @pTypeList;                        { arbitrary, as long as it points to 4 bytes
  789.                                                          of valid memory }
  790.         END
  791.     ELSE
  792.         BEGIN
  793.         LockHandleHigh(Handle(typeList));                { in case Std File does allocations }
  794.         pTypeList := SFTypeListHandle(typeList)^;
  795.         END;
  796.  
  797.     {$IFC qDebug}
  798.     { Causes TApplication.GetEvent to call CheckRsrcUsage. }
  799.     gRsrcCheck := 0;
  800.     {$ENDC}
  801.  
  802.     UpdateAllWindows;                                    { needed to work around bug in SF; if all
  803.                                                          windows are not updated you wont be able
  804.                                                          to mount a disk correctly }
  805.  
  806.     SFPGetFile(where, '', fileFilter, numTypes, pTypeList^, dlgHook, reply, dlgID, filterProc);
  807.  
  808.     Handle(typeList) := DisposeIfHandle(typeList);
  809.  
  810.     ChooseDocument := reply.good;
  811.     IF reply.good THEN
  812.         BEGIN
  813.         anAppFile.vRefnum := reply.vRefnum;
  814.         anAppFile.fType := reply.fType;
  815.         anAppFile.versNum := reply.version;
  816.         anAppFile.fName := reply.fName;
  817.         END;
  818.     END;
  819.  
  820. {--------------------------------------------------------------------------------------------------}
  821. {$S MAClipboard}
  822.  
  823. PROCEDURE TApplication.ClaimClipboard(clipView: TView);
  824.  
  825.     BEGIN
  826.     AbandonUndoClipboard;                                { free up any old UNDO stuff }
  827.     gClipUndoView := gClipView;                         { Copy current clipboard contents to the
  828.                                                          Undo side }
  829.     IF clipView <> NIL THEN
  830.         SetClipView(clipView)                            { Will install it as gClipView }
  831.     ELSE
  832.         BEGIN
  833.         {$IFC qDebug}
  834.         ProgramBreak('Claiming clipboard with null view');
  835.         {$ENDC}
  836.         END;
  837.  
  838.     gClipClaimed := TRUE;
  839.     END;
  840.  
  841. {--------------------------------------------------------------------------------------------------}
  842. {$S MATerminate}
  843.  
  844. PROCEDURE TApplication.Close;
  845.  
  846.     VAR
  847.         WMgrWindow:         WindowPtr;
  848.  
  849.     PROCEDURE FreeIt(anEvtHandler: TEvtHandler);
  850.  
  851.         BEGIN
  852.         FreeIfObject(anEvtHandler);                     { ??? also call Terminate ??? }
  853.         anEvtHandler := NIL;
  854.         END;
  855.  
  856.     PROCEDURE CloseADocument(aDocument: TDocument);
  857.  
  858.         BEGIN
  859.         aDocument.Close;
  860.         END;
  861.  
  862.     BEGIN
  863.     { Close all of the windows }
  864.     REPEAT
  865.         WMgrWindow := FrontWindow;
  866.         IF WMgrWindow <> NIL THEN
  867.             CloseWMgrWindow(WMgrWindow);
  868.     UNTIL WMgrWindow = NIL;
  869.  
  870.     { Close any windowless documents }
  871.     ForAllDocumentsDo(CloseADocument);
  872.  
  873.     gPrintHandler.Terminate;
  874.     IF gHeadCoHandler <> NIL THEN
  875.         gHeadCoHandler.EachHandler(FreeIt);
  876.     IF LoadScrap <> noErr THEN;                         { ??? }
  877.     END;
  878.  
  879. {--------------------------------------------------------------------------------------------------}
  880. {$S MAClose}
  881.  
  882. PROCEDURE TApplication.CloseWMgrWindow(aWMgrWindow: WindowPtr);
  883.  
  884.     VAR
  885.         aWindow:            TWindow;
  886.  
  887.     BEGIN
  888.     IF IsDeskAccessory(aWMgrWindow) THEN
  889.         CloseDeskAcc(WindowPeek(aWMgrWindow)^.windowKind)
  890.     ELSE
  891.         BEGIN
  892.         aWindow := WMgrToWindow(aWMgrWindow);
  893.         IF aWindow <> NIL THEN
  894.             aWindow.CloseByUser
  895.         ELSE
  896.             HideWindow(aWMgrWindow);
  897.         END;
  898.     END;
  899.  
  900. {--------------------------------------------------------------------------------------------------}
  901. {$S MAApplicationRes}
  902.  
  903. PROCEDURE TApplication.CommitLastCommand;
  904.  
  905.     BEGIN
  906.     AbandonUndoClipboard;
  907.  
  908.     IF fLastCommand <> NIL THEN
  909.         BEGIN
  910.         IF fLastCommand.fCmdDone THEN
  911.             fLastCommand.Commit;
  912.         IF fLastCommand.fFreeOnCompletion THEN
  913.             FreeIfObject(fLastCommand);
  914.         fLastCommand := NIL;
  915.         END;
  916.     END;
  917.  
  918. {--------------------------------------------------------------------------------------------------}
  919. {$S MAApplicationRes}
  920.  
  921. FUNCTION TApplication.CountClicks(aPDownEvent: EventRecordPtr;
  922.                                   whereMouseDown: integer): integer;
  923.  
  924.     VAR
  925.         clickCount:         integer;
  926.  
  927.     BEGIN
  928.     clickCount := 1;
  929.  
  930.     WITH aPDownEvent^ DO
  931.         BEGIN
  932.         { This series of IF's generates less code than short-circuit booleans }
  933.         IF whereMouseDown = gLastClickPart THEN
  934.             IF gClickCount > 0 THEN                     { not the first click and ... }
  935.                 IF when - gLastUpTime < GetDblTime THEN { ... close enough in time and ... }
  936.                     IF gTarget.DoMultiClick(gLastMsePt, where) { ... close enough in space } THEN
  937.                         clickCount := gClickCount + 1;
  938.  
  939.         gLastMsePt := where;
  940.         END;
  941.  
  942.     gLastClickPart := whereMouseDown;
  943.     gClickCount := clickCount;
  944.     CountClicks := clickCount;
  945.     END;
  946.  
  947. {--------------------------------------------------------------------------------------------------}
  948. {$S MAClose}
  949.  
  950. PROCEDURE TApplication.DeleteDocument(docToDelete: TDocument);
  951.  
  952.     BEGIN
  953.     gDocList.Delete(docToDelete);
  954.     END;
  955.  
  956. {--------------------------------------------------------------------------------------------------}
  957. {$S MAApplicationRes}
  958.  
  959. PROCEDURE TApplication.DeleteFreeWindow(windowToDelete: TWindow);
  960.  
  961.     BEGIN
  962.     gFreeWindowList.Delete(windowToDelete);
  963.     END;
  964.  
  965. {--------------------------------------------------------------------------------------------------}
  966. {$S MAApplicationRes}
  967.  
  968. PROCEDURE TApplication.DispatchEvent(VAR theEventInfo: EventInfo;
  969.                                      VAR commandToPerform: TCommand);
  970.  
  971.     BEGIN
  972.     commandToPerform := NIL;
  973.  
  974.     WITH theEventInfo.thePEvent^ DO
  975.         BEGIN
  976.  
  977.         CASE what OF
  978.             mouseUp:
  979.                 commandToPerform := HandleMouseUp(theEventInfo);
  980.  
  981.             mouseDown:
  982.                 commandToPerform := HandleMouseDown(theEventInfo);
  983.  
  984.             activateEvt:
  985.                 commandToPerform := HandleActivateEvent(theEventInfo);
  986.  
  987.             updateEvt:
  988.                 commandToPerform := HandleUpdateEvent(theEventInfo);
  989.  
  990.             keyDown, autoKey:
  991.                 commandToPerform := HandleKeyDownEvent(theEventInfo);
  992.  
  993.             keyUp:
  994.                 { !!! We'd like to have a chain for keyUp but a MultiFinder™ bug
  995.                 (at least up to 6.0) keep us from reliably getting keyUp events
  996.                 after minor context switches (background updates, etc.).  It replaces
  997.                 the global event mask (which we would have had to change to get keyups
  998.                 in the first place) with the wrong mask.  Oh well, we had such good intentions! } ;
  999.  
  1000.             diskEvt:
  1001.                 commandToPerform := HandleDiskEvent(theEventInfo);
  1002.  
  1003.             app4Evt:
  1004.             { All app4Evt's are owned by the system }
  1005.                 commandToPerform := HandleSystemEvent(theEventInfo);
  1006.  
  1007.             OTHERWISE
  1008.                 commandToPerform := HandleAlienEvent(theEventInfo);
  1009.  
  1010.         END;
  1011.  
  1012.         END;
  1013.     END;
  1014.  
  1015. {--------------------------------------------------------------------------------------------------}
  1016. {$S MAApplicationRes}
  1017.  
  1018. FUNCTION TApplication.DoCommandKey(ch: CHAR;
  1019.                                    VAR info: EventInfo): TCommand; OVERRIDE;
  1020.  
  1021.     BEGIN
  1022.     DoCommandKey := NIL;
  1023.     IF (NOT info.theAutoKey) & (NOT InModalMenuState) THEN
  1024.         BEGIN
  1025.         SetupTheMenus;
  1026.         { If you want to have case sensitive command keys use the following line because
  1027.         KeyEventToComponents returns the correct character for shifted keys when the command
  1028.         key is down.  That lets us test for things like command-period correctly.  So… in order
  1029.         to be backward compatible (sigh) we now have to ignore the _correct_ char that is passed
  1030.         in (and is in info.theCharacter) and use the old ToolBox supplied unPasteurized character that
  1031.         is left in the actual EventRecord at info.thePEvent^ }
  1032.  
  1033.         { DoCommandKey := MenuEvent(MenuKey(ch)); }
  1034.  
  1035.         DoCommandKey := MenuEvent(MenuKey(chr(BAND(info.thePEvent^.message, charCodeMask))));
  1036.  
  1037.         END;
  1038.     END;
  1039.  
  1040. {--------------------------------------------------------------------------------------------------}
  1041. {$S MAApplicationRes}
  1042.  
  1043. FUNCTION TApplication.DoKeyCommand(ch: CHAR;
  1044.                                    aKeyCode: integer;
  1045.                                    VAR info: EventInfo): TCommand; OVERRIDE;
  1046.  
  1047.     PROCEDURE HandleFunctionKey(cmd: CmdNumber);
  1048.  
  1049.         BEGIN
  1050.         SetupTheMenus;
  1051.         IF CmdEnabled(cmd) THEN
  1052.             DoKeyCommand := gTarget.DoMenuCommand(cmd);
  1053.         END;
  1054.  
  1055.     BEGIN
  1056.     DoKeyCommand := NIL;
  1057.     CASE aKeyCode OF
  1058.         kF1VirtualCode:
  1059.             HandleFunctionKey(cUndo);
  1060.         kF2VirtualCode:
  1061.             HandleFunctionKey(cCut);
  1062.         kF3VirtualCode:
  1063.             HandleFunctionKey(cCopy);
  1064.         kF4VirtualCode:
  1065.             HandleFunctionKey(cPaste);
  1066.         kClearVirtualCode:
  1067.             HandleFunctionKey(cClear);
  1068.         OTHERWISE
  1069.             DoKeyCommand := INHERITED DoKeyCommand(ch, aKeyCode, info);
  1070.     END;
  1071.     END;
  1072.  
  1073. {--------------------------------------------------------------------------------------------------}
  1074. {$S MAOpen}
  1075.  
  1076. FUNCTION TApplication.DoMakeDocument(itsCmdNumber: CmdNumber): TDocument;
  1077. { E X A M P L E
  1078.     VAR aYOURDocument: TDocument;
  1079.  
  1080.     BEGIN
  1081.     New(aYOURDocument);
  1082.     aYOURDocument.IYOURDocument(itsDocKind, ...);
  1083.     DoMakeDocument := aYOURDocument;
  1084.     END;
  1085.  }
  1086.  
  1087.     VAR
  1088.         aDocument:            TDocument;
  1089.  
  1090.     BEGIN
  1091.     { Allocate and initialize the document}
  1092.     aDocument := NIL;
  1093.  
  1094.     IF qTemplateViews THEN
  1095.         aDocument := TDocument(NewStdObject(kStdDocument))
  1096.     ELSE
  1097.         New(aDocument);
  1098.  
  1099.     FailNil(aDocument);
  1100.  
  1101.     aDocument.IDocument(gMainFileType, '????', kUsesDataFork, NOT kUsesRsrcFork, NOT kDataOpen,
  1102.                         NOT kRsrcOpen);
  1103.     DoMakeDocument := aDocument;
  1104.     END;
  1105.  
  1106. {--------------------------------------------------------------------------------------------------}
  1107. {$S MASelCommand}
  1108.  
  1109. FUNCTION TApplication.DoMenuCommand(aCmdNumber: CmdNumber): TCommand;
  1110.  
  1111.     VAR
  1112.         succeeded:            BOOLEAN;
  1113.         aDocument:            TDocument;
  1114.         aWindow:            TWindow;
  1115.         aNewDocCommand:     TNewDocCommand;
  1116.         aOldDocCommand:     TOldDocCommand;
  1117.         aAboutAppCommand:    TAboutAppCommand;
  1118.         aQuitCommand:        TQuitCommand;
  1119.         aUndoRedoCommand:    TUndoRedoCommand;
  1120.  
  1121.         oldObjectPerm:        BOOLEAN;
  1122.         just:                INTEGER;
  1123.  
  1124.         {$IFC qDebug}
  1125.         aDebugCommand:        TDebugCommand;
  1126.         oldState:            BOOLEAN;
  1127.         {$ENDC}
  1128.  
  1129.         {$IFC qInspector}
  1130.         aInspectorCommand:    TInspectorCommand;
  1131.         oldIState:            BOOLEAN;
  1132.         {$ENDC}
  1133.  
  1134.     BEGIN
  1135.     { ==================================================================================
  1136.     Some commands will be returned to perform actions that must _ALWAYS_ be available.
  1137.     The allocation cannot be allowed to fail.  So we do a temp allocation which by
  1138.     definition cannot be allowed to fail.  This strategy is used wherever we want to use
  1139.     command objects but don't want to leave the user twisting in the breeze.
  1140.     NOTE: Don't forget to allow for this memory in your mem! resource if you copy this
  1141.     style in your own code.
  1142.     ================================================================================== }
  1143.  
  1144.     aWindow := GetActiveWindow;
  1145.     DoMenuCommand := NIL;
  1146.  
  1147.     CASE aCmdNumber OF
  1148.         cQuit:
  1149.             BEGIN
  1150.  
  1151.             oldObjectPerm := AllocateObjectsFromPerm(FALSE);
  1152.             New(aQuitCommand);
  1153.             IF AllocateObjectsFromPerm(oldObjectPerm) THEN;
  1154.  
  1155.             FailNil(aQuitCommand);                        { just in case }
  1156.             aQuitCommand.IQuitCommand(aCmdNumber);
  1157.             DoMenuCommand := aQuitCommand;
  1158.             END;
  1159.  
  1160.         cNew..cNewLast, cFinderNew:
  1161.             BEGIN
  1162.             New(aNewDocCommand);
  1163.             FailNil(aNewDocCommand);
  1164.             aNewDocCommand.INewDocCommand(aCmdNumber);
  1165.             DoMenuCommand := aNewDocCommand;
  1166.             END;
  1167.  
  1168.         cOpen..cOpenLast:
  1169.             BEGIN
  1170.             New(aOldDocCommand);
  1171.             FailNil(aOldDocCommand);
  1172.             aOldDocCommand.IOldDocCommand(aCmdNumber);
  1173.             DoMenuCommand := aOldDocCommand;
  1174.             END;
  1175.  
  1176.         cClose:
  1177.             BEGIN
  1178.             IF qDebug & (WMgrToWindow(FrontWindow) <> NIL) THEN
  1179.                 ProgramBreak(
  1180. 'The frontmost window is a window object but didn''t handle the cClose CmdNumber, your TWindow subclass probably forgot to call INHERITED DoMenuCommand!'
  1181.                              );
  1182.  
  1183.             CloseWMgrWindow(FrontWindow);                { TWindow would have handled the command
  1184.                                                          before we get here so the window is
  1185.                                                          probably a DA or something }
  1186.             END;
  1187.  
  1188.         cShowClipboard:
  1189.             IF gClipWindow = aWindow THEN
  1190.                 gClipWindow.Close                        { Hide the clipboard }
  1191.             ELSE
  1192.                 BEGIN
  1193.                 gClipWindow.Open;
  1194.                 gClipWindow.Select;
  1195.                 END;
  1196.  
  1197.         cAboutApp:
  1198.             BEGIN
  1199.             New(aAboutAppCommand);
  1200.             FailNil(aAboutAppCommand);
  1201.             aAboutAppCommand.IAboutAppCommand(aCmdNumber);
  1202.             DoMenuCommand := aAboutAppCommand;
  1203.             END;
  1204.  
  1205.         {$IFC qDebug}
  1206.         cDebugWind:
  1207.             DebugShowTranscriptWindow;
  1208.         cExperimenting:
  1209.             gExperimenting := NOT gExperimenting;
  1210.         cReportEvt:
  1211.             gReportEvt := NOT gReportEvt;
  1212.         cDebugPrinting:
  1213.             gDebugPrinting := NOT gDebugPrinting;
  1214.         cReportMenuChoices:
  1215.             gReportMenuChoices := NOT gReportMenuChoices;
  1216.         cIntenseDebugging:
  1217.             gIntenseDebugging := NOT gIntenseDebugging;
  1218.         cIdentifySoftware:
  1219.             BEGIN
  1220.             Writeln;
  1221.             Writeln('===== Software Version(s): =====');
  1222.             Writeln(kCopyright);
  1223.             gTarget.IdentifySoftware;
  1224.             END;
  1225.         cRefreshFrontWindow:
  1226.             IF aWindow <> NIL THEN
  1227.                 aWindow.ForceRedraw;
  1228.         cModalToggle:
  1229.             IF aWindow <> NIL THEN
  1230.                 aWindow.fIsModal := NOT aWindow.fIsModal;
  1231.         cDoFirstClick:
  1232.             IF aWindow <> NIL THEN
  1233.                 aWindow.fDoFirstClick := NOT aWindow.fDoFirstClick;
  1234.         cSetSysJust:
  1235.             BEGIN
  1236.             { swap the current setting }
  1237.             IF GetActualJustification(teJustSystem) = teJustLeft THEN
  1238.                 just := teJustRight
  1239.             ELSE
  1240.                 just := teJustLeft;
  1241.  
  1242.             { stuff the new setting }
  1243.             IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
  1244.                 SetSysJust(just)
  1245.             ELSE IF qNeedsROM128k | gConfiguration.hasROM128k THEN
  1246.                 IntegerPtr(kLMTESysJust)^ := just;
  1247.             END;
  1248.  
  1249.         cEnterMacAppDebugger:
  1250.             BEGIN
  1251.             oldObjectPerm := AllocateObjectsFromPerm(FALSE);
  1252.             oldState := AddNewObjectsToInspector(FALSE);
  1253.             New(aDebugCommand);
  1254.             IF AddNewObjectsToInspector(oldState) THEN;
  1255.             IF AllocateObjectsFromPerm(oldObjectPerm) THEN;
  1256.  
  1257.             FailNil(aDebugCommand);                     { just in case }
  1258.             aDebugCommand.IDebugCommand(aCmdNumber);
  1259.             DoMenuCommand := aDebugCommand;
  1260.             END;
  1261.         {$ENDC}
  1262.  
  1263.         {$IFC qDebug}
  1264.         cTraceSetupMenus:
  1265.             gTraceSetupMenus := NOT gTraceSetupMenus;
  1266.         cTraceIdle:
  1267.             gTraceIdle := NOT gTraceIdle;
  1268.         {$ENDC}
  1269.  
  1270.         {$IFC qInspector}
  1271.         cNewInspectorWindow:
  1272.             BEGIN
  1273.             oldIState := AddNewObjectsToInspector(FALSE);
  1274.             New(aInspectorCommand);
  1275.             IF AddNewObjectsToInspector(oldIState) THEN;
  1276.             FailNil(aInspectorCommand);
  1277.             aInspectorCommand.IInspectorCommand(aCmdNumber);
  1278.             DoMenuCommand := aInspectorCommand;
  1279.             END;
  1280.         {$ENDC}
  1281.  
  1282.         cUndo                                            { , cRedo } :
  1283.             BEGIN
  1284.             oldObjectPerm := AllocateObjectsFromPerm(FALSE);
  1285.             New(aUndoRedoCommand);
  1286.             IF AllocateObjectsFromPerm(oldObjectPerm) THEN;
  1287.  
  1288.             FailNil(aUndoRedoCommand);                    { just in case }
  1289.             aUndoRedoCommand.IUndoRedoCommand(aCmdNumber);
  1290.             DoMenuCommand := aUndoRedoCommand;
  1291.             END;
  1292.  
  1293.         OTHERWISE
  1294.             DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber);
  1295.     END;
  1296.     END;
  1297.  
  1298. {--------------------------------------------------------------------------------------------------}
  1299. {$S MAApplicationRes}
  1300.  
  1301. PROCEDURE TApplication.DoSetupMenus;
  1302.  
  1303.     VAR
  1304.         lowSpace:            BOOLEAN;
  1305.         aWindowPtr:         WindowPtr;
  1306.  
  1307.     BEGIN
  1308.     INHERITED DoSetupMenus;
  1309.  
  1310.     lowSpace := MemSpaceIsLow;
  1311.  
  1312.     Enable(cAboutApp, TRUE);
  1313.  
  1314.     Enable(cQuit, gEventLevel <= 1);                    { Can't enable Quit if in nested event
  1315.                                                          handling }
  1316.     Enable(cShowClipboard, TRUE);
  1317.     SetMenuState(cShowClipboard, kIDBuzzString, bzShowClip, bzHideClip, gClipWindow =
  1318.                  GetActiveWindow);
  1319.  
  1320.     Enable(cNew, NOT lowSpace);
  1321.     Enable(cOpen, NOT lowSpace);
  1322.  
  1323.     aWindowPtr := FrontWindow;
  1324.     IF (aWindowPtr <> NIL) & (WMgrToWindow(aWindowPtr) = NIL) THEN
  1325.         Enable(cClose, WindowPeek(aWindowPtr)^.goAwayFlag <> FALSE); { window objects will take care
  1326.                                                                       of themselves, but we take
  1327.                                                                       care of the indigent. }
  1328.     END;
  1329.  
  1330. {--------------------------------------------------------------------------------------------------}
  1331. {$S MAAboutApp}
  1332.  
  1333. VAR
  1334.     hadCreditsStringList: BOOLEAN;                        { does the rsrc 'STR#' = kDefaultCredits
  1335.                                                          exist ? }
  1336.     lastCreditsStringIndex: integer;                    { the last string in the STR# to be
  1337.                                                          displayed }
  1338.     lastCreditsShownTicks: LONGINT;                     { the tickcount when the last Credit was
  1339.                                                          Shown }
  1340.     originalText:        StringHandle;                    { the about box's original text (prior to
  1341.                                                          credits) }
  1342.     waitTicks:            integer;                        { how long to wait between credits }
  1343.  
  1344. FUNCTION DoShowAboutAppFilter(theDialog: DialogPtr;
  1345.                               VAR theEvent: EventRecord;
  1346.                               VAR itemHit: integer): BOOLEAN;
  1347.  
  1348.     VAR
  1349.         s:                    Str255;
  1350.         originalStr:        Str255;
  1351.         item:                Handle;
  1352.  
  1353.     FUNCTION GetFirstStaticText(theDialog: DialogPtr): Handle;
  1354.  
  1355.         VAR
  1356.             itemType:            integer;
  1357.             item:                Handle;
  1358.             itemNo:             integer;
  1359.             box:                Rect;
  1360.  
  1361.         BEGIN
  1362.         GetFirstStaticText := NIL;
  1363.         itemNo := 1;
  1364.         REPEAT
  1365.             item := NIL;
  1366.             GetDItem(theDialog, itemNo, itemType, item, box);
  1367.             IF BAND(itemType, $7F) = statText THEN        { we don't care if its enabled or not }
  1368.                 BEGIN
  1369.                 GetFirstStaticText := item;
  1370.                 LEAVE;
  1371.                 END
  1372.             ELSE
  1373.                 itemNo := succ(itemNo);
  1374.         UNTIL item = NIL;
  1375.         END;
  1376.  
  1377.     PROCEDURE DoKeyDown(itemNo: integer);
  1378.     { Handle a keypress that has been mapped to the OK button. }
  1379.  
  1380.         VAR
  1381.             itemType:            integer;
  1382.             item:                Handle;
  1383.             finalTicks:         LONGINT;
  1384.             box:                Rect;
  1385.  
  1386.         BEGIN
  1387.         DoShowAboutAppFilter := TRUE;
  1388.         itemHit := itemNo;
  1389.         GetDItem(theDialog, itemNo, itemType, item, box);
  1390.         IF itemType = (ctrlItem + btnCtrl) THEN
  1391.             BEGIN                                        { this code gives visual feedback }
  1392.             HiliteControl(ControlHandle(item), inButton); { hilite the button }
  1393.             Delay(8, finalTicks);                        { delay for 8 ticks }
  1394.             HiliteControl(ControlHandle(item), 0);        { stop hiliting the button }
  1395.             END;
  1396.         END;
  1397.  
  1398.     BEGIN
  1399.     DoShowAboutAppFilter := FALSE;
  1400.  
  1401.     CASE theEvent.what OF
  1402.         keyDown:
  1403.             CASE chr(BAND(theEvent.message, charCodeMask)) OF
  1404.                 chEnter, chReturn:
  1405.                     DoKeyDown(ok);
  1406.             END;
  1407.         nullEvent:
  1408.             IF (TickCount - lastCreditsShownTicks) > waitTicks THEN
  1409.                 BEGIN
  1410.                 item := GetFirstStaticText(theDialog);
  1411.                 GetIndString(s, kDefaultCredits, lastCreditsStringIndex);
  1412.                 IF s <> '' THEN
  1413.                     BEGIN
  1414.                     { save the original text }
  1415.                     IF (lastCreditsStringIndex = 1) & (originalText^^ = '') & (item <> NIL) THEN
  1416.                         BEGIN
  1417.                         GetIText(item, originalStr);
  1418.                         SetString(originalText, originalStr);
  1419.                         END;
  1420.                     lastCreditsStringIndex := succ(lastCreditsStringIndex);
  1421.                     lastCreditsShownTicks := TickCount;
  1422.                     IF item <> NIL THEN
  1423.                         SetIText(item, s);
  1424.                     waitTicks := Min((length(s) * 6), 60);
  1425.                     END
  1426.                 ELSE                                    { no more items }
  1427.                     BEGIN
  1428.                     lastCreditsStringIndex := 1;
  1429.                     lastCreditsShownTicks := TickCount;
  1430.                     IF item <> NIL THEN
  1431.                         BEGIN
  1432.                         BlockMove(Ptr(originalText^), @originalStr, length(originalText^^) + 1);
  1433.                         SetIText(item, originalStr);
  1434.                         END;
  1435.                     waitTicks := 6 * 60;
  1436.                     END;
  1437.                 END;
  1438.     END;
  1439.  
  1440.     { Forward on to the standard filter }
  1441.     IF gMacAppAlertFilter <> NIL THEN
  1442.         DoShowAboutAppFilter := CallAlertFilter(theDialog, theEvent, itemHit, gMacAppAlertFilter);
  1443.  
  1444.     END;
  1445.  
  1446. PROCEDURE TApplication.DoShowAboutApp;
  1447. { Method to display the "About" box for your application.  Override to do interesting things.
  1448. Since it is normally called from a command; the app usually has the maximum free space available. }
  1449.  
  1450.     VAR
  1451.         apName:             Str255;
  1452.         apRefnum:            integer;
  1453.         apParam:            Handle;
  1454.  
  1455.     BEGIN
  1456.     FailSpaceIsLow;
  1457.     GetAppParms(apName, apRefnum, apParam);
  1458.     ParamText(apName, '', '', '');                        { Put Application name in the about box }
  1459.     hadCreditsStringList := (GetResource('STR#', kDefaultCredits) <> NIL);
  1460.     IF hadCreditsStringList THEN
  1461.         BEGIN
  1462.         lastCreditsStringIndex := 1;
  1463.         lastCreditsShownTicks := TickCount;
  1464.         waitTicks := 5 * 60;
  1465.         originalText := NewString('');
  1466.         IF MacAppAlert(phAboutApp, @DoShowAboutAppFilter) <> 0 THEN;
  1467.         Handle(originalText) := DisposeIfHandle(originalText);
  1468.         END
  1469.     ELSE
  1470.         StdAlert(phAboutApp);
  1471.     END;
  1472.  
  1473. {--------------------------------------------------------------------------------------------------}
  1474. {$S MAApplicationRes}
  1475.  
  1476. PROCEDURE TApplication.EachFreeWindow(PROCEDURE DoToWindow(aWindow: TWindow));
  1477.  
  1478.     BEGIN
  1479.     gFreeWindowList.Each(DoToWindow);
  1480.     END;
  1481.  
  1482. {--------------------------------------------------------------------------------------------------}
  1483. {$S MAFields}
  1484.  
  1485. PROCEDURE TApplication.Fields(PROCEDURE DoToField(fieldName: Str255;
  1486.                                                   fieldAddr: Ptr;
  1487.                                                   fieldType: integer)); OVERRIDE;
  1488.  
  1489.     BEGIN
  1490.     DoToField('TApplication', NIL, bClass);
  1491.     DoToField('fCommandQueue', @fCommandQueue, bObject);
  1492.     DoToField('fLastCommand', @fLastCommand, bObject);
  1493.     DoToField('fLaunchWithNewDocument', @fLaunchWithNewDocument, bBoolean);
  1494.  
  1495.     DoToField('fTicksOfLastIdle', @fTicksOfLastIdle, bLongint);
  1496.     DoToField('fTicksTilNextIdle', @fTicksTilNextIdle, bLongint);
  1497.  
  1498.     DoToField('gAppDone', @gAppDone, bBoolean);
  1499.     DoToField('gApplication', @gApplication, bObject);
  1500.  
  1501.     TextStyleFields('gApplicationStyle', gApplicationStyle, DoToField);
  1502.  
  1503.     {$IFC qDebug}
  1504.     DoToField('gBusyTempRgn', @gBusyTempRgn, bBoolean);
  1505.     {$EndC}
  1506.     DoToField('gChooserOK', @gChooserOK, bBoolean);
  1507.     DoToField('gClickCount', @gClickCount, bInteger);
  1508.     DoToField('gClipClaimed', @gClipClaimed, bBoolean);
  1509.     DoToField('gClipOrphanage', @gClipOrphanage, bObject);
  1510.     DoToField('gClipUndoView', @gClipUndoView, bObject);
  1511.     DoToField('gClipView', @gClipView, bObject);
  1512.     DoToField('gClipWindow', @gClipWindow, bObject);
  1513.     DoToField('gClipWrittenToDeskScrap', @gClipWrittenToDeskScrap, bBoolean);
  1514.  
  1515.     ConfigRecFields('gConfiguration', gConfiguration, DoToField);
  1516.  
  1517.     DoToField('gCouldPrint', @gCouldPrint, bBoolean);
  1518.     DoToField('gCurrPrintHandler', @gCurrPrintHandler, bObject);
  1519.     DoToField('gCursorRgn', @gCursorRgn, bRgnHandle);
  1520.     {$IFC qDebug}
  1521.     DoToField('gDebugPrinting', @gDebugPrinting, bBoolean);
  1522.     {$EndC}
  1523.     DoToField('gDocList', @gDocList, bObject);
  1524.     DoToField('gDrawingPictScrap', @gDrawingPictScrap, bBoolean);
  1525.     DoToField('gDrawingPictScrapView', @gDrawingPictScrapView, bObject);
  1526.     DoToField('gErrorParm3', @gErrorParm3, bString);
  1527.     DoToField('gEventLevel', @gEventLevel, bInteger);
  1528.     {$IFC qDebug}
  1529.     DoToField('gExperimenting', @gExperimenting, bBoolean);
  1530.     {$EndC}
  1531.     DoToField('gFileCount', @gFileCount, bInteger);
  1532.     DoToField('gFinderPrinting', @gFinderPrinting, bBoolean);
  1533.     DoToField('gFocusedView', @gFocusedView, bObject);
  1534.     DoToField('gFreeWindowList', @gFreeWindowList, bObject);
  1535.     DoToField('gGotClipType', @gGotClipType, bBoolean);
  1536.     DoToField('gHeadCohandler', @gHeadCoHandler, bObject);
  1537.     DoToField('gIdlePhase', @gIdlePhase, bByte);
  1538.     DoToField('gInBackground', @gInBackground, bBoolean);
  1539.     DoToField('gInitialized', @gInitialized, bBoolean);
  1540.     {$IFC qDebug}
  1541.     DoToField('gIntenseDebugging', @gIntenseDebugging, bBoolean);
  1542.     {$EndC}
  1543.     DoToField('gLastClickPart', @gLastClickPart, bInteger);
  1544.     DoToField('gLastDeskAcc', @gLastDeskAcc, bLongint);
  1545.     DoToField('gLastMsePt', @gLastMsePt, bPoint);
  1546.     DoToField('gLastUpTime', @gLastUpTime, bLongint);
  1547.     DoToField('gLongOffset', @gLongOffset, bVPoint);
  1548.     DoToField('gLowSpaceInterval', @gLowSpaceInterval, bLongint);
  1549.     DoToField('gMainEventMask', @gMainEventMask, bHexInteger);
  1550.     DoToField('gMainFileType', @gMainFileType, bOSType);
  1551.     DoToField('gMBarDisplayed', @gMBarDisplayed, bInteger);
  1552.     DoToField('gMBarHeight', @gMBarHeight, bInteger);
  1553.     DoToField('gMBarHierarchical', @gMBarHierarchical, bInteger);
  1554.     DoToField('gMBarNotDisplayed', @gMBarNotDisplayed, bInteger);
  1555.     DoToField('gMenusAreSetup', @gMenusAreSetup, bBoolean);
  1556.     ScrapStuffFields('gNewScrapStuff', gNewScrapStuff, DoToField);
  1557.     DoToField('gNextSpaceMsg', @gNextSpaceMsg, bLongint);
  1558.     DoToField('gNoChanges', @gNoChanges, bObject);
  1559.     DoToField('gNullPrintHandler', @gNullPrintHandler, bObject);
  1560.     DoToField('gNumUntitled', @gNumUntitled, bInteger);
  1561.     DoToField('gOldChooserFlag', @gOldChooserFlag, bBoolean);
  1562.     ScrapStuffFields('gOldScrapStuff', gOldScrapStuff, DoToField);
  1563.     DoToField('gOrthogonal[h]', @gOrthogonal[h], bByte);
  1564.     DoToField('gOrthogonal[v]', @gOrthogonal[v], bByte);
  1565.     DoToField('gPageOffset', @gPageOffset, bVPoint);
  1566.     DoToField('gPrefClipType', @gPrefClipType, bOSType);
  1567.     DoToField('gPrintHandler', @gPrintHandler, bObject);
  1568.     DoToField('gPrinting', @gPrinting, bBoolean);
  1569.     DoToField('gRedrawMenuBar', @gRedrawMenuBar, bBoolean);
  1570.     {$IFC qDebug}
  1571.     DoToField('gReportEvt', @gReportEvt, bBoolean);
  1572.     {$EndC}
  1573.     {$IFC qDebug}
  1574.     DoToField('gReportMenuChoices', @gReportMenuChoices, bBoolean);
  1575.     {$EndC}
  1576.     {$IFC qDebug}
  1577.     DoToField('gRsrcCheck', @gRsrcCheck, bBoolean);
  1578.     {$EndC}
  1579.     DoToField('gSaveFocusRec', NIL, bTitle);
  1580.     DoToField('  isValid', @gSaveFocusRec.isValid, bBoolean);
  1581.     DoToField('  clip', @gSaveFocusRec.clip, bRgnHandle);
  1582.     DoToField('  drawingPictScrap', @gSaveFocusRec.drawingPictScrap, bBoolean);
  1583.     DoToField('  drawingPictScrapView', @gSaveFocusRec.drawingPictScrapView, bObject);
  1584.     DoToField('  focusedView', @gSaveFocusRec.focusedView, bObject);
  1585.     DoToField('  longOffset', @gSaveFocusRec.longOffset, bVPoint);
  1586.     DoToField('  org', @gSaveFocusRec.org, bPoint);
  1587.     DoToField('  port', @gSaveFocusRec.port, bWindowPtr);
  1588.     DoToField('  printing', @gSaveFocusRec.printing, bBoolean);
  1589.     DoToField('gSignatureCount', @gSignatureCount, bInteger);
  1590.     DoToField('gStdHysteresis', @gStdHysteresis, bPoint);
  1591.     DoToField('gStdStaggerCount', @gStdStaggerCount, bInteger);
  1592.     DoToField('gStdWMoveBounds', @gStdWMoveBounds, bRect);
  1593.     DoToField('gStdWSizeRect', @gStdWSizeRect, bRect);
  1594.     DoToField('gStdWScreenRect', @gStdWScreenRect, bRect);
  1595.     DoToField('gSysWindowActive', @gSysWindowActive, bBoolean);
  1596.  
  1597.     TextStyleFields('gSystemStyle', gSystemStyle, DoToField);
  1598.  
  1599.     DoToField('gTarget', @gTarget, bObject);
  1600.     DoToField('gTempRgn', @gTempRgn, bRgnHandle);
  1601.     {$IFC qDebug}
  1602.     DoToField('gTraceIdle', @gTraceIdle, bBoolean);
  1603.     {$EndC}
  1604.     DoToField('gUndoState', @gUndoState, bBoolean);
  1605.     DoToField('gUndoCmd', @gUndoCmd, bInteger);
  1606.     {$IFC qDebug}
  1607.     DoToField('gUsedBy', @gUsedBy, bString);
  1608.     {$EndC}
  1609.     DoToField('gVarClipPicSize', @gVarClipPicSize, bBoolean);
  1610.     DoToField('gWorkPort', @gWorkPort, bGrafPtr);
  1611.     DoToField('gWResSignature', @gWResSignature, bIDType);
  1612.     DoToField('gWResType', @gWResType, bString);
  1613.     DoToField('gZeroPt', @gZeroPt, bPoint);
  1614.     DoToField('gZeroRect', @gZeroRect, bRect);
  1615.     DoToField('gZeroVPt', @gZeroVPt, bVPoint);
  1616.     DoToField('gZeroVRect', @gZeroVRect, bVRect);
  1617.  
  1618.     INHERITED Fields(DoToField);
  1619.     END;
  1620.  
  1621. {--------------------------------------------------------------------------------------------------}
  1622. {$S MAApplicationRes}
  1623.  
  1624. PROCEDURE TApplication.ForAllDocumentsDo(PROCEDURE DoToDoc(aDocument: TDocument));
  1625.  
  1626.     BEGIN
  1627.     gDocList.Each(DoToDoc);
  1628.     END;
  1629.  
  1630. {--------------------------------------------------------------------------------------------------}
  1631. {$S MAApplicationRes}
  1632.  
  1633. PROCEDURE TApplication.ForAllWindowsDo(PROCEDURE DoToWind(aWindow: TWindow));
  1634.  
  1635.     PROCEDURE DoToYourWindows(aDocument: TDocument);
  1636.  
  1637.         BEGIN
  1638.         aDocument.ForAllWindowsDo(DoToWind);
  1639.         END;
  1640.  
  1641.     BEGIN
  1642.     ForAllDocumentsDo(DoToYourWindows);
  1643.     EachFreeWindow(DoToWind);
  1644.     END;
  1645.  
  1646. {--------------------------------------------------------------------------------------------------}
  1647. {$S MAInspector}
  1648.  
  1649. PROCEDURE TApplication.GetInspectorName(VAR inspectorName: Str255);
  1650.  
  1651.     BEGIN
  1652.     IF SELF = gApplication THEN
  1653.         inspectorName := 'gApplication';
  1654.     END;
  1655.  
  1656. {--------------------------------------------------------------------------------------------------}
  1657. {$S MAClipboard}
  1658.  
  1659. FUNCTION TApplication.GetDataToPaste(aDataHandle: Handle;
  1660.                                      VAR dataType: ResType): LONGINT;
  1661.  
  1662.     VAR
  1663.         err:                LONGINT;
  1664.         myType:             ResType;
  1665.  
  1666.     BEGIN
  1667.     IF gGotClipType THEN
  1668.         BEGIN
  1669.         dataType := gPrefClipType;
  1670.  
  1671.         err := gClipView.GivePasteData(aDataHandle, dataType);
  1672.  
  1673.         IF err < 0 THEN
  1674.             Failure(err, 0);
  1675.         END
  1676.     ELSE
  1677.         BEGIN
  1678.         {$IFC qDebug}
  1679.         ProgramBreak('GetDataToPaste called when gGotClipType was FALSE');
  1680.         {$ENDC}
  1681.         END;
  1682.  
  1683.     GetDataToPaste := err;
  1684.     END;
  1685.  
  1686. {--------------------------------------------------------------------------------------------------}
  1687. {$S MAApplicationRes}
  1688.  
  1689. FUNCTION TApplication.GetEvent(eventMask: integer;
  1690.                                sleep: LONGINT;
  1691.                                cursorRgn: RgnHandle;
  1692.                                VAR anEvent: EventRecord): BOOLEAN;
  1693.  
  1694.     CONST
  1695.         kMaxSleep            = 60;                        { max sleep in foreground so MultiFinder
  1696.                                                          gives time to non-desk accessory drivers }
  1697.  
  1698.     VAR
  1699.         haveEvent:            BOOLEAN;
  1700.         {$IFC qPerform}
  1701.         oldSetting:         BOOLEAN;
  1702.         {$ENDC}
  1703.  
  1704.     BEGIN
  1705.  
  1706.     {$IFC qDebug}
  1707.     gRsrcCheck := gRsrcCheck - 1;
  1708.     IF gRsrcCheck <= 0 THEN
  1709.         BEGIN
  1710.         CheckRsrcUsage;
  1711.         gRsrcCheck := kRsrcCheckInterval;
  1712.         END;
  1713.     {$ENDC qDebug}
  1714.  
  1715.     IF qNeedsWaitNextEvent | gConfiguration.hasWaitNextEvent THEN
  1716.         BEGIN
  1717.         {$IFC qDebug}
  1718.         IF gIntenseDebugging & gReportEvt THEN
  1719.             BEGIN
  1720.             WRITE('WaitNextEvent: sleep=', sleep: 0);
  1721.             { faceless driver bug fixed in MF 7.0 }
  1722.             IF (gConfiguration.systemVersion < $700) & NOT gInBackground THEN
  1723.                 WRITE(', MaxSleep=', kMaxSleep: 0);
  1724.  
  1725.             IF cursorRgn = NIL THEN
  1726.                 WRITE(', cursor region=NIL')
  1727.             ELSE
  1728.                 WrLblRect(', cursor', cursorRgn^^.rgnBBox);
  1729.             Writeln;
  1730.             END;
  1731.         {$ENDC}
  1732.         ActivateBusyCursor(FALSE);                        { Turn off busy cursor while we're away.}
  1733.  
  1734.         {$IFC qPerform}
  1735.         oldSetting := DebugPerfMonitor(FALSE);
  1736.         {$ENDC}
  1737.  
  1738.         { faceless driver bug fixed in MF 7.0 }
  1739.         IF (gConfiguration.systemVersion < $700) & NOT gInBackground THEN
  1740.             sleep := Min(sleep, kMaxSleep);
  1741.  
  1742.         haveEvent := WaitNextEvent(eventMask, anEvent, sleep, cursorRgn);
  1743.  
  1744.         {$IFC qPerform}
  1745.         IF DebugPerfMonitor(oldSetting) THEN;
  1746.         {$ENDC}
  1747.  
  1748.         IF NOT gInBackground THEN                        { If we're not in the background, then }
  1749.             ActivateBusyCursor(TRUE);                    { …enable the busy cursor mechanism. }
  1750.         END
  1751.     ELSE
  1752.         BEGIN
  1753.         {$IFC qPerform}
  1754.         oldSetting := DebugPerfMonitor(FALSE);
  1755.         {$ENDC}
  1756.  
  1757.         SystemTask;
  1758.         haveEvent := GetNextEvent(eventMask, anEvent);
  1759.  
  1760.         {$IFC qPerform}
  1761.         IF DebugPerfMonitor(oldSetting) THEN;
  1762.         {$ENDC}
  1763.         END;
  1764.  
  1765.     GetEvent := haveEvent;
  1766.  
  1767.     END;
  1768.  
  1769. {--------------------------------------------------------------------------------------------------}
  1770. {$S MAApplicationRes}
  1771.  
  1772. FUNCTION TApplication.GetFrontWindow: TWindow;
  1773.  
  1774.     PROCEDURE DoToWMgrWindow(theWMgrWindow: WindowPtr);
  1775.  
  1776.         VAR
  1777.             aWindow:            TWindow;
  1778.  
  1779.         BEGIN
  1780.         aWindow := WMgrToWindow(theWMgrWindow);
  1781.         IF (aWindow <> NIL) & aWindow.IsShown & (NOT aWindow.fFloats) THEN
  1782.             BEGIN
  1783.             GetFrontWindow := aWindow;
  1784.             EXIT(GetFrontWindow)
  1785.             END;
  1786.         END;
  1787.  
  1788.     BEGIN
  1789.     GetFrontWindow := NIL;
  1790.     IF NOT IsDeskAccessory(FrontWindow) THEN
  1791.         EachWMgrWindowDo(DoToWMgrWindow);
  1792.     END;
  1793.  
  1794. {--------------------------------------------------------------------------------------------------}
  1795. {$S MAApplicationRes}
  1796.  
  1797. FUNCTION TApplication.GetActiveWindow: TWindow;
  1798.  
  1799.     PROCEDURE DoToWMgrWindow(theWMgrWindow: WindowPtr);
  1800.  
  1801.         VAR
  1802.             aWindow:            TWindow;
  1803.  
  1804.         BEGIN
  1805.         aWindow := WMgrToWindow(theWMgrWindow);
  1806.         IF (aWindow <> NIL) & aWindow.IsShown & aWindow.fIsActive & (NOT aWindow.fFloats) THEN
  1807.             BEGIN
  1808.             GetActiveWindow := aWindow;
  1809.             EXIT(GetActiveWindow)
  1810.             END;
  1811.         END;
  1812.  
  1813.     BEGIN
  1814.     GetActiveWindow := NIL;
  1815.     IF NOT IsDeskAccessory(FrontWindow) THEN
  1816.         EachWMgrWindowDo(DoToWMgrWindow);
  1817.     END;
  1818.  
  1819. {--------------------------------------------------------------------------------------------------}
  1820. {$S MAApplicationRes}
  1821.  
  1822. FUNCTION TApplication.GetLastCommand: TCommand;
  1823.  
  1824.     BEGIN
  1825.     GetLastCommand := fLastCommand;
  1826.     END;
  1827.  
  1828. {--------------------------------------------------------------------------------------------------}
  1829. {$S MAApplicationRes}
  1830.  
  1831. FUNCTION TApplication.GetNextCommand: TCommand;
  1832.  
  1833.     VAR
  1834.         aCommand:            TCommand;
  1835.  
  1836.     FUNCTION IsReadyToGo(command: TCommand): BOOLEAN;
  1837.  
  1838.         BEGIN
  1839.         IsReadyToGo := command.IsReadyToExecute;
  1840.         END;
  1841.  
  1842.     BEGIN
  1843.     IF NOT fCommandQueue.IsEmpty THEN
  1844.         BEGIN
  1845.         aCommand := TCommand(fCommandQueue.FirstThat(IsReadyToGo));
  1846.         IF (aCommand <> NIL) & NOT aCommand.fRecurring THEN
  1847.             fCommandQueue.Delete(aCommand);
  1848.         GetNextCommand := aCommand;
  1849.         END
  1850.     ELSE
  1851.         GetNextCommand := NIL;
  1852.     END;
  1853.  
  1854. {--------------------------------------------------------------------------------------------------}
  1855. {$S MAOpen}
  1856.  { ??? We should not muck with the window template; the extra code isn't worth it
  1857.   since programmer can easily change the resource file ??? }
  1858.  
  1859. FUNCTION TApplication.GetRsrcWindow(storage: Ptr;
  1860.                                     rsrcId: integer;
  1861.                                     VAR isResizable, isClosable: BOOLEAN): WindowPtr;
  1862. { We force INVISIBLE in the WIND definition so the screen won't flash. }
  1863.  
  1864.     TYPE
  1865.         WINDTemplate        = RECORD
  1866.             bounds:             Rect;
  1867.             procID:             integer;
  1868.             visible, filler1:    BOOLEAN;
  1869.             goAway, filler2:    BOOLEAN;
  1870.             refcon:             LONGINT;
  1871.             itemsID:            integer;                { only for DLOG resource }
  1872.             END;
  1873.         WINDTemplatePtr    = ^WINDTemplate;
  1874.         WINDTemplateHandle = ^WINDTemplatePtr;
  1875.  
  1876.     VAR
  1877.         aWMgrWindow:        WindowPtr;
  1878.         templateHandle:     WINDTemplateHandle;
  1879.         rsrcType:            ResType;
  1880.         ditl:                Handle;
  1881.         oldPerm:            BOOLEAN;
  1882.         fi:                 FailInfo;
  1883.  
  1884.     PROCEDURE HdlFailure(error: integer;
  1885.                          message: LONGINT);             { ??? ERROR ??? }
  1886.  
  1887.         BEGIN
  1888.         { Make sure the perm allocation flag is set back to what it was
  1889.           when we entered GetRsrcWindow. }
  1890.         oldPerm := PermAllocation(oldPerm);
  1891.         END;
  1892.  
  1893.     BEGIN
  1894.     oldPerm := PermAllocation(FALSE);
  1895.    { Even though the window is permanent, we allocate it
  1896.  under a temporary flag so that the maximum memory
  1897.  is available. Quickdraw can blow up if it can't
  1898.  allocate a grafPort. }
  1899.  
  1900.     CatchFailures(fi, HdlFailure);
  1901.  
  1902.     templateHandle := WINDTemplateHandle(GetResource('WIND', rsrcId));
  1903.     FailNILResource(templateHandle);
  1904.     MoveHHi(Handle(templateHandle));                    { in case it is locked by the ROM }
  1905.  
  1906.     WITH templateHandle^^ DO
  1907.         BEGIN
  1908.         { ignore request for zoomDocProc if not 128K ROM, because
  1909.         the user might be running pre-3.0 System, which can't
  1910.         handle zoomDocProc }
  1911.         IF NOT qNeedsROM128K & NOT gConfiguration.hasROM128K THEN
  1912.             procID := BAND(procID, $FFF7);
  1913.  
  1914.         visible := FALSE;
  1915.         isClosable := goAway;
  1916.         isResizable := (procID = documentProc) | (procID = zoomDocProc);
  1917.    { If your own defProc is resizable, too, then after
  1918.    the call on GetRsrcWindow, set isResizable TRUE }
  1919.         END;
  1920.  
  1921.     IF qNeedsColorQD | gConfiguration.hasColorQD THEN
  1922.         aWMgrWindow := WindowPtr(GetNewCWindow(rsrcId, Pointer(storage), Pointer( - 1)))
  1923.     ELSE
  1924.         aWMgrWindow := GetNewWindow(rsrcId, Pointer(storage), Pointer( - 1));
  1925.  
  1926.     FailNil(aWMgrWindow);
  1927.     oldPerm := PermAllocation(oldPerm);
  1928.     Success(fi);                                        { Don't need the failure handler since we've
  1929.                                                          set the perm allocation flag back. }
  1930.  
  1931.     { Now we must make sure that the code reserve is still intact.}
  1932.     IF NOT CheckReserve THEN
  1933.         BEGIN
  1934.         aWMgrWindow := FreeIfWMgrWindow(aWMgrWindow, storage = NIL);
  1935.  
  1936.         Failure(memFullErr, 0);
  1937.         END;
  1938.  
  1939.     GetRsrcWindow := aWMgrWindow;
  1940.     END;
  1941.  
  1942. {--------------------------------------------------------------------------------------------------}
  1943. {$S MAApplicationRes}
  1944.  
  1945. FUNCTION TApplication.HandleActivateEvent(VAR theEventInfo: EventInfo): TCommand;
  1946.  
  1947.     VAR
  1948.         aWindow:            TWindow;
  1949.  
  1950.     BEGIN
  1951.     WITH theEventInfo, thePEvent^ DO
  1952.         BEGIN
  1953.         aWindow := WMgrToWindow(WindowPtr(message));
  1954.         IF aWindow <> NIL THEN
  1955.             aWindow.Activate(Odd(modifiers));
  1956.         END;
  1957.  
  1958.     HandleActivateEvent := NIL;
  1959.     END;
  1960.  
  1961. {--------------------------------------------------------------------------------------------------}
  1962. {$S MAApplicationRes}
  1963.  
  1964. FUNCTION TApplication.HandleAlienEvent(VAR theEventInfo: EventInfo): TCommand;
  1965.  
  1966.     VAR
  1967.         aCommand:            TCommand;
  1968.         anEvtHandler:        TEvtHandler;
  1969.  
  1970.     FUNCTION TakeEvent(anEvtHandler: TEvtHandler): BOOLEAN;
  1971.  
  1972.         BEGIN
  1973.         TakeEvent := anEvtHandler.DoHandleEvent(theEventInfo.thePEvent, aCommand);
  1974.         END;
  1975.  
  1976.     BEGIN
  1977.     aCommand := NIL;
  1978.     IF gHeadCoHandler <> NIL THEN
  1979.         anEvtHandler := gHeadCoHandler.FirstHandlerThat(TakeEvent);
  1980.     HandleAlienEvent := aCommand;
  1981.     END;
  1982.  
  1983. {--------------------------------------------------------------------------------------------------}
  1984. {$S MADoCommand}
  1985.  
  1986. FUNCTION TApplication.HandleDiskEvent(VAR theEventInfo: EventInfo): TCommand;
  1987.  
  1988.     CONST
  1989.         topLeft             = $00500070;
  1990.  
  1991.     VAR
  1992.         err:                integer;
  1993.  
  1994.     BEGIN
  1995.     WITH theEventInfo.thePEvent^ DO
  1996.         IF HiWrd(message) <> noErr THEN
  1997.             BEGIN
  1998.             err := DIBadMount(Point(topLeft), message); { ??? do something with the error ??? }
  1999.             {$IFC qDebug}
  2000.             IF err <> noErr THEN
  2001.                 Writeln('error from DIBadMount is ', err: 1);
  2002.             {$ENDC}
  2003.             END;
  2004.  
  2005.     HandleDiskEvent := NIL;
  2006.  
  2007.     END;
  2008.  
  2009. {--------------------------------------------------------------------------------------------------}
  2010. {$S MAApplicationRes}
  2011.  
  2012. PROCEDURE TApplication.HandleEvent(VAR theEvent: EventRecord);
  2013.  
  2014.     VAR
  2015.         fi:                 FailInfo;
  2016.         commandToPerform:    TCommand;
  2017.         theEventInfo:        EventInfo;
  2018.         {$IFC qDebug}
  2019.         aMAName:            MAName;
  2020.         {$ENDC}
  2021.  
  2022.     PROCEDURE HandleFailure(error: OSErr;
  2023.                             message: LONGINT);
  2024.  
  2025.         BEGIN
  2026.         PostHandleEvent(theEventInfo);
  2027.         END;
  2028.  
  2029.     BEGIN
  2030.     {$IFC qDebug}
  2031.     IF gReportEvt THEN
  2032.         ReportEvent(theEvent);
  2033.     {$ENDC}
  2034.  
  2035.     WITH theEventInfo, theEvent DO
  2036.         BEGIN
  2037.         thePEvent := @theEvent;
  2038.         theBtnState := BAND(modifiers, btnState) <> 0;
  2039.         theCmdKey := BAND(modifiers, cmdKey) <> 0;
  2040.         theShiftKey := BAND(modifiers, shiftKey) <> 0;
  2041.         theAlphaLock := BAND(modifiers, alphaLock) <> 0;
  2042.         theOptionKey := BAND(modifiers, optionKey) <> 0;
  2043.         theControlKey := BAND(modifiers, controlKey) <> 0;
  2044.         theAutoKey := what = autoKey;
  2045.         theClickCount := gClickCount;
  2046.         theCharacter := chr(0);                         { Default, we don't know if this is a
  2047.                                                          keystroke yet }
  2048.         theKeyCode := 0;                                { Default, we don't know if this is a
  2049.                                                          keystroke yet }
  2050.         affectsMenus := TRUE;                            { assume going in that this event affects
  2051.                                                          the menus }
  2052.         END;
  2053.  
  2054.     CatchFailures(fi, HandleFailure);
  2055.  
  2056.     DispatchEvent(theEventInfo, commandToPerform);
  2057.  
  2058.     IF (commandToPerform <> NIL) THEN                    { Send the command out to be executed }
  2059.         PostCommand(commandToPerform);
  2060.  
  2061.     Success(fi);
  2062.  
  2063.     PostHandleEvent(theEventInfo);
  2064.  
  2065.     END;
  2066.  
  2067. {--------------------------------------------------------------------------------------------------}
  2068. {$S MAApplicationRes}
  2069.  
  2070. FUNCTION OptionKeyIsDown: BOOLEAN;
  2071.  
  2072.     CONST
  2073.         kOptionKey            = 58;
  2074.  
  2075.     VAR
  2076.         theKeys:            KeyMap;
  2077.  
  2078.     BEGIN
  2079.     GetKeys(theKeys);
  2080.     OptionKeyIsDown := theKeys[kOptionKey];
  2081.     END;
  2082.  
  2083. {--------------------------------------------------------------------------------------------------}
  2084. {$S MAFinder}
  2085.  
  2086. PROCEDURE TApplication.HandleFinderRequest;
  2087.  
  2088.     LABEL 1, 2;
  2089.  
  2090.     VAR
  2091.         i:                    integer;
  2092.         anAppFile:            AppFile;
  2093.         continuePrinting:    BOOLEAN;
  2094.         cmd:                CmdNumber;
  2095.         fi:                 FailInfo;
  2096.         aCommand:            TCommand;
  2097.  
  2098.         { ??? need better error messages here ??? }
  2099.  
  2100.     PROCEDURE HdlORequest(error: OSErr;
  2101.                           message: LONGINT);
  2102.  
  2103.         BEGIN
  2104.         IF error <> noErr THEN
  2105.             BEGIN
  2106.             IF message = 0 THEN
  2107.                 BEGIN
  2108.                 gErrorParm3 := anAppFile.fName;
  2109.                 IF cmd = cFinderPrint THEN
  2110.                     message := msgPrintFailed
  2111.                 ELSE
  2112.                     message := msgOpenFailed;
  2113.                 END;
  2114.             ShowError(error, message);
  2115.             END;
  2116.         GOTO 1;                                         { continue the loop }
  2117.         END;
  2118.  
  2119.     PROCEDURE HdlNRequest(error: OSErr;
  2120.                           message: LONGINT);
  2121.  
  2122.         BEGIN
  2123.         IF error <> noErr THEN
  2124.             ShowError(error, message);                    { PollEvent's error handler not in place yet
  2125.                                                          }
  2126.         GOTO 2;                                         { exit the method }
  2127.         END;
  2128.  
  2129.     BEGIN
  2130.     {$IFC qDebug}
  2131.     IF gExperimenting THEN
  2132.         Writeln('File count: ', gFileCount: 1);
  2133.     {$ENDC}
  2134.  
  2135.     IF gFileCount = 0 THEN
  2136.         BEGIN
  2137.         aCommand := NIL;
  2138.         CatchFailures(fi, HdlNRequest);
  2139.  
  2140.         IF OptionKeyIsDown THEN
  2141.             aCommand := DoMenuCommand(cOpen)
  2142.         ELSE IF fLaunchWithNewDocument THEN
  2143.             aCommand := DoMenuCommand(cFinderNew);
  2144.  
  2145.         IF aCommand <> NIL THEN
  2146.             PostCommand(aCommand);
  2147.         Success(fi);
  2148.  
  2149.         END
  2150.     ELSE                                                { it's an OPEN or PRINT of 1 or more
  2151.                                                          existing files }
  2152.         BEGIN
  2153.         continuePrinting := TRUE;
  2154.  
  2155.         IF gFinderPrinting THEN
  2156.             cmd := cFinderPrint
  2157.         ELSE
  2158.             cmd := cFinderOpen;
  2159.  
  2160.         FOR i := 1 TO gFileCount DO
  2161.             BEGIN
  2162.             CatchFailures(fi, HdlORequest);
  2163.  
  2164.             GetAppFiles(i, anAppFile);
  2165.  
  2166.             IF CanOpenDocument(cmd, anAppFile) THEN
  2167.                 BEGIN
  2168.                 ClrAppFiles(i);
  2169.  
  2170.                 IF gFinderPrinting THEN
  2171.                     BEGIN
  2172.                     IF continuePrinting THEN
  2173.                         continuePrinting := PrintDocument(anAppFile);
  2174.                     END
  2175.                 ELSE
  2176.                     OpenOld(cFinderOpen, anAppFile);
  2177.                 END
  2178.             ELSE
  2179.                 Failure(errNotMyType, 0);
  2180.  
  2181.             Success(fi);
  2182.         1:                                                { continue the loop }
  2183.             END;
  2184.         END;
  2185. 2:                                                        { exit the method }
  2186.     END;
  2187.  
  2188. {--------------------------------------------------------------------------------------------------}
  2189. {$S MAApplicationRes}
  2190.  
  2191. FUNCTION TApplication.HandleKeyDownEvent(VAR theEventInfo: EventInfo): TCommand;
  2192.  
  2193.     BEGIN
  2194.     WITH theEventInfo, thePEvent^ DO
  2195.         BEGIN
  2196.         gTarget.KeyEventToComponents(theEventInfo);     { Find out what keys were _REALLY_ pressed }
  2197.  
  2198.         IF theCmdKey THEN
  2199.             HandleKeyDownEvent := gTarget.DoCommandKey(theCharacter, theEventInfo)
  2200.         ELSE
  2201.             HandleKeyDownEvent := gTarget.DoKeyCommand(theCharacter, theKeyCode, theEventInfo);
  2202.         END;
  2203.     END;
  2204.  
  2205. {--------------------------------------------------------------------------------------------------}
  2206. {$S MAApplicationRes}
  2207.  
  2208. FUNCTION TApplication.HandleMouseDown(VAR theEventInfo: EventInfo): TCommand;
  2209.  
  2210.     VAR
  2211.         doClick:            BOOLEAN;
  2212.         aWindow:            TWindow;
  2213.         aWMgrWindow:        WindowPtr;
  2214.         whereMouseDown:     integer;
  2215.         sysWindowAct:        BOOLEAN;
  2216.         aCommand:            TCommand;
  2217.         theMouse:            Point;
  2218.         theVMouse:            VPoint;
  2219.         hysteresis:         Point;
  2220.  
  2221.     BEGIN
  2222.     HandleMouseDown := NIL;
  2223.  
  2224.     WITH theEventInfo, thePEvent^ DO
  2225.         BEGIN
  2226.         whereMouseDown := FindWindow(where, aWMgrWindow);
  2227.         theClickCount := CountClicks(thePEvent, whereMouseDown);
  2228.  
  2229.         aWindow := WMgrToWindow(aWMgrWindow);
  2230.  
  2231.         IF ((whereMouseDown = inMenuBar) & InModalMenuState) | ((whereMouseDown <> inMenuBar) &
  2232.            InModalState & (aWindow <> GetActiveWindow)) THEN
  2233.             BEGIN
  2234.             Beep(2);
  2235.             EXIT(HandleMouseDown);
  2236.             END;
  2237.  
  2238.         END;
  2239.  
  2240.     IF whereMouseDown <> inContent THEN
  2241.         SetCursor(arrow);
  2242.  
  2243.     WITH theEventInfo, thePEvent^ DO
  2244.         CASE whereMouseDown OF
  2245.             inMenuBar:
  2246.                 BEGIN
  2247.                 SetupTheMenus;                            { gives application a chance to setup
  2248.                                                          individual menu items }
  2249.                 HandleMouseDown := MenuEvent(MenuSelect(where));
  2250.                 END;
  2251.  
  2252.             inSysWindow:
  2253.                 SystemClick(thePEvent^, aWMgrWindow);
  2254.  
  2255.             OTHERWISE
  2256.                     { if a MacApp window was associated with the WindowPtr then let the window object
  2257.                     decide what to do with the mouse click }
  2258.                 IF (aWindow <> NIL) & aWindow.Focus THEN { if we can't focus, we're in trouble }
  2259.                     BEGIN
  2260.                     theMouse := where;
  2261.                     GlobalToLocal(theMouse);
  2262.                     aWindow.QDToViewPt(theMouse, theVMouse);
  2263.                     hysteresis := gStdHysteresis;        { don't want std changed by var }
  2264.                     IF aWindow.HandleMouseDown(theVMouse, theEventInfo, hysteresis, aCommand) &
  2265.                        (aCommand <> NIL) THEN
  2266.                         BEGIN
  2267.                         aCommand.fTracksMouse := TRUE;    {??? someday this won't be forced }
  2268.                         aCommand.fInitialPt := where;    {??? someday this won't be forced }
  2269.                         HandleMouseDown := aCommand;
  2270.                         END;
  2271.                     END
  2272.                 ELSE IF qDebug THEN
  2273.                     BEGIN
  2274.                     IF aWindow <> NIL THEN
  2275.                         ProgramBreak(
  2276.                               'In TApplication.HandleMouseDown: couldn''t focus on a window object!'
  2277.                                      )
  2278.                     ELSE IF gIntenseDebugging THEN
  2279.                         Writeln('Got a mouse event for a non-MacApp, non-system window');
  2280.                     END;
  2281.  
  2282.         END;
  2283.     END;
  2284.  
  2285. {--------------------------------------------------------------------------------------------------}
  2286. {$S MAApplicationRes}
  2287.  
  2288. FUNCTION TApplication.HandleMouseUp(VAR theEventInfo: EventInfo): TCommand;
  2289.  
  2290.     BEGIN
  2291.     { Remember time of last mouse up, in order to detect double clicks }
  2292.     gLastUpTime := theEventInfo.thePEvent^.when;
  2293.     HandleMouseUp := NIL;
  2294.     END;
  2295.  
  2296. {--------------------------------------------------------------------------------------------------}
  2297. {$S MAApplicationRes}
  2298.  
  2299. FUNCTION TApplication.HandleSystemEvent(VAR theEventInfo: EventInfo): TCommand;
  2300.  
  2301.     CONST
  2302.         kOsEvtMessageMask    = $FF000000;
  2303.  
  2304.     VAR
  2305.         switchingIn:        BOOLEAN;
  2306.         convertClipboard:    BOOLEAN;
  2307.         aWindow:            TWindow;
  2308.  
  2309.     BEGIN
  2310.     WITH theEventInfo.thePEvent^ DO
  2311.         CASE BSR(BAND(message, kOsEvtMessageMask), 24) OF
  2312.             kSuspendOrResume:
  2313.                 BEGIN
  2314.                 switchingIn := Odd(message);
  2315.                 convertClipboard := BAND(message, $00000002) <> 0;
  2316.  
  2317.                 IF switchingIn THEN
  2318.                     RegainControl(convertClipboard)
  2319.                 ELSE
  2320.                     AboutToLoseControl(convertClipboard);
  2321.  
  2322.                 IF switchingIn THEN
  2323.                     aWindow := GetFrontWindow
  2324.                 ELSE
  2325.                     aWindow := GetActiveWindow;
  2326.  
  2327.                 IF aWindow <> NIL THEN
  2328.                     aWindow.Activate(switchingIn);
  2329.                 gInBackground := NOT switchingIn;
  2330.                 InvalidateCursorRgn;
  2331.                 END;
  2332.             kMouseMovedMessage:
  2333.                 BEGIN
  2334.                 theEventInfo.affectsMenus := FALSE;     { We don't think mouse tracking usually
  2335.                                                          bothers the menus. }
  2336.                 IF TrackCursor THEN;                    { Recalculate the cursor region. After all
  2337.                                                          that's why we got a mouse moved event }
  2338.                 END;
  2339.             OTHERWISE
  2340.                 IF gIntenseDebugging THEN
  2341.                     Writeln('in TApplication.HandleSystemEvent: got unrecognized event');
  2342.         END;
  2343.  
  2344.     HandleSystemEvent := NIL;
  2345.     END;
  2346.  
  2347. {--------------------------------------------------------------------------------------------------}
  2348. {$S MAApplicationRes}
  2349.  
  2350. FUNCTION TApplication.HandleUpdateEvent(VAR theEventInfo: EventInfo): TCommand;
  2351.  
  2352.     VAR
  2353.         aWindow:            TWindow;
  2354.  
  2355.     BEGIN
  2356.     WITH theEventInfo.thePEvent^ DO
  2357.         BEGIN
  2358.         aWindow := WMgrToWindow(WindowPtr(message));
  2359.         IF aWindow <> NIL THEN
  2360.             aWindow.Update;
  2361.         END;
  2362.     HandleUpdateEvent := NIL;
  2363.     END;
  2364.  
  2365. {--------------------------------------------------------------------------------------------------}
  2366. {$S MADebug}
  2367.  
  2368. PROCEDURE TApplication.IdentifySoftware;
  2369.  
  2370.     BEGIN
  2371.     WRITELN('UMacApp of 14 Feb 90 (Valentine''s Day), Compiled on ', COMPDATE, ' @ ', COMPTIME);
  2372.  
  2373.     IDUObject;
  2374.     {$IFC qDebug}
  2375.     IDUDebug;
  2376.     {$EndC}
  2377.     END;
  2378.  
  2379. {--------------------------------------------------------------------------------------------------}
  2380. {$S MAApplicationRes}
  2381.  
  2382. PROCEDURE TApplication.Idle(phase: IdlePhase);
  2383.  
  2384.     VAR
  2385.         currTick:            LONGINT;
  2386.         fi:                 FailInfo;
  2387.  
  2388.     PROCEDURE HdlIdle(error: OSErr;
  2389.                       message: LONGINT);
  2390.  
  2391.         BEGIN
  2392.         gInhibitNestedHandling := TRUE;                 { Don't want to come back into Idle From
  2393.                                                          alert filters or other strange places }
  2394.  
  2395.         END;
  2396.  
  2397.     PROCEDURE DoIdleAction(anEvtHandler: TEvtHandler);
  2398.  
  2399.         VAR
  2400.             didFree:            BOOLEAN;
  2401.             ticksTilNextIdle:    LONGINT;
  2402.  
  2403.         BEGIN
  2404.       { If this handler needs idling, and enough ticks have elapsed
  2405.        since the last time it was idled, call its DoIdle. (This was not
  2406.        made a TEvtHandler method in order to optimize idling speed.) }
  2407.         WITH anEvtHandler DO
  2408.             BEGIN
  2409.             didFree := FALSE;
  2410.             IF fIdleFreq <> kMaxIdleTime THEN            { Does it idle at all? }
  2411.                 BEGIN
  2412.                 IF (phase <> idleContinue) | (currTick - fLastIdle >= fIdleFreq) THEN
  2413.                     BEGIN
  2414.                     didFree := anEvtHandler.DoIdle(phase);
  2415.                     IF NOT didFree THEN
  2416.                         fLastIdle := currTick;
  2417.                     END;
  2418.                 IF NOT didFree & (fIdleFreq <> kMaxIdleTime) THEN
  2419.                     BEGIN
  2420.                     IF fLastIdle = 0 THEN
  2421.                         ticksTilNextIdle := fIdleFreq
  2422.                     ELSE
  2423.                         ticksTilNextIdle := Max(fLastIdle + fIdleFreq - currTick, 0); { accounts for
  2424.                         overdue }
  2425.                     fTicksTilNextIdle := Min(ticksTilNextIdle, fTicksTilNextIdle); { update the
  2426.                         composite }
  2427.                     END;
  2428.                 END;
  2429.             END;
  2430.         END;
  2431.  
  2432.     BEGIN
  2433.     CatchFailures(fi, HdlIdle);
  2434.  
  2435.     currTick := TickCount;
  2436.  
  2437.     IF phase = idleBegin THEN
  2438.         BEGIN
  2439.         {$IFC qDebug}
  2440.         gWasTrcEnable := TRCEnable(gTraceIdle);         { Trace during idle only if user wants to. }
  2441.         {$ENDC}
  2442.         IF NOT gInFilter & MemSpaceIsLow THEN
  2443.             SpaceIsLow
  2444.         ELSE
  2445.             gNextSpaceMsg := currTick;
  2446.  
  2447.         SetupTheMenus;                                    { To get the menu bar redrawn if necessary.}
  2448.         fTicksTilNextIdle := 0;                         { Force idling event handlers &
  2449.                                                          co-handlers.}
  2450.         END;
  2451.  
  2452.     IF (phase <> idleContinue) | (currTick - fTicksOfLastIdle >= fTicksTilNextIdle) THEN
  2453.         BEGIN
  2454.         fTicksTilNextIdle := kMaxIdleTime;
  2455.         IF gHeadCoHandler <> NIL THEN
  2456.             gHeadCoHandler.EachHandler(DoIdleAction);
  2457.         IF qDebug THEN
  2458.             Assertion(gTarget <> NIL, AtStr('gTarget <> nil'));
  2459.         gTarget.EachHandler(DoIdleAction);
  2460.         fTicksOfLastIdle := currTick;
  2461.         END;
  2462.  
  2463.     { If we have WaitNextEvent then the cursor will be tracked via MouseMoved events. }
  2464.     IF (NOT (qNeedsWaitNextEvent | gConfiguration.hasWaitNextEvent) | gAlwaysTrackCursor) &
  2465.        (phase <> idleEnd) THEN
  2466.         BEGIN
  2467.         IF TrackCursor THEN;                            { Recompute the cursor region if necessary.
  2468.                                                          }
  2469.         END
  2470.         {$IFC qDebug}
  2471.     ELSE IF TRCEnable(gWasTrcEnable) THEN                { restore tracing state at end of idle.}
  2472.     {$ENDC}
  2473.     ;
  2474.     Success(fi);
  2475.     END;
  2476.  
  2477. {--------------------------------------------------------------------------------------------------}
  2478. {$S MAApplicationRes}
  2479.  
  2480. FUNCTION TApplication.InModalState: BOOLEAN;
  2481.  
  2482.     VAR
  2483.         aWindow:            TWindow;
  2484.         aWindowPtr:         WindowPtr;
  2485.  
  2486.     BEGIN
  2487.     InModalState := FALSE;        { Initialize the function result }
  2488.     aWindowPtr := FrontWindow;
  2489.  
  2490.     { in case the front window is an alert or something }
  2491.  
  2492.     IF (WMgrToWindow(aWindowPtr) = NIL) & (aWindowPtr <> NIL) THEN
  2493.         CASE GetWindowVariant(aWindowPtr) OF
  2494.             dBoxProc, plainDBox, altDBoxProc:
  2495.                 InModalState := TRUE;
  2496.         END
  2497.     ELSE
  2498.         BEGIN
  2499.         aWindow := GetActiveWindow;
  2500.         InModalState := (aWindow <> NIL) & (aWindow.fIsModal);
  2501.         END;
  2502.     END;
  2503.  
  2504. {--------------------------------------------------------------------------------------------------}
  2505. {$S MAApplicationRes}
  2506.  
  2507. FUNCTION TApplication.InModalMenuState: BOOLEAN;
  2508.  
  2509.     VAR
  2510.         aWindow:            TWindow;
  2511.         aWindowPtr:         WindowPtr;
  2512.  
  2513.     BEGIN
  2514.     InModalMenuState := FALSE;        { Initialize the function result }
  2515.     aWindowPtr := FrontWindow;
  2516.  
  2517.     { in case the front window is an alert or something }
  2518.  
  2519.     IF (WMgrToWindow(aWindowPtr) = NIL) & (aWindowPtr <> NIL) THEN
  2520.         CASE GetWindowVariant(aWindowPtr) OF
  2521.             dBoxProc, plainDBox, altDBoxProc:
  2522.                 InModalMenuState := TRUE;
  2523.         END
  2524.     ELSE
  2525.         BEGIN
  2526.         aWindow := GetActiveWindow;
  2527.         InModalMenuState := (aWindow <> NIL) & NOT aWindow.AllowsMenuAccess;
  2528.         END;
  2529.     END;
  2530.  
  2531. {--------------------------------------------------------------------------------------------------}
  2532. {$S MANonRes}
  2533.  
  2534. PROCEDURE TApplication.InstallCohandler(aCohandler: TEvtHandler;
  2535.                                         addIt: BOOLEAN);
  2536.  
  2537.     BEGIN
  2538.     fTicksTilNextIdle := 0;                             { Force idling event handlers &
  2539.                                                          co-handlers.}
  2540.     IF addIt THEN
  2541.         gHeadCoHandler := aCohandler.AddHandler(gHeadCoHandler)
  2542.     ELSE
  2543.         gHeadCoHandler := aCohandler.RemoveHandler(gHeadCoHandler);
  2544.     END;
  2545.  
  2546. {--------------------------------------------------------------------------------------------------}
  2547. {$S MAApplicationRes}
  2548.  
  2549. FUNCTION TApplication.IsDeskAccessory(aWMgrWindow: WindowPtr): BOOLEAN;
  2550.  
  2551.     BEGIN
  2552.     IsDeskAccessory := (aWMgrWindow <> NIL) & (WindowPeek(aWMgrWindow)^.windowKind < 0);
  2553.     END;
  2554.  
  2555. {--------------------------------------------------------------------------------------------------}
  2556. {$S MAApplicationRes}
  2557.  
  2558. PROCEDURE TApplication.InvalidateCursorRgn;
  2559.  
  2560.     BEGIN
  2561.     IF gCursorRgn <> NIL THEN
  2562.         SetEmptyRgn(gCursorRgn);                        { Make sure it gets changed back }
  2563.     END;
  2564.  
  2565. {--------------------------------------------------------------------------------------------------}
  2566. {$S MAApplicationRes}
  2567.  
  2568. PROCEDURE TApplication.InvalidateFocus;
  2569.  
  2570.     BEGIN
  2571.     IF gFocusedView <> NIL THEN
  2572.         gFocusedView.InvalidateFocus;
  2573.     END;
  2574.  
  2575. {--------------------------------------------------------------------------------------------------}
  2576. {$S MAApplicationRes}
  2577.  
  2578. PROCEDURE TApplication.KeyEventToComponents(VAR info: EventInfo);
  2579. { See Tech Note #263 for the reason for this abomination }
  2580.  
  2581.     CONST
  2582.         kMaskModifier        = $FE00;                    { need to strip command key from Modifiers }
  2583.         kMaskASCII1         = $000000FF;                { get key from KeyTrans return }
  2584.         kMaskASCII2         = $00FF0000;                { get key from KeyTrans return }
  2585.         kPeriod             = ord('.');
  2586.         kUpKeyMask            = $0080;
  2587.         kMAsmKeyCache        = 38;                        {!!! Replace with system supplied constant
  2588.                                                         when sys 7.0 headers ship }
  2589.  
  2590.     TYPE
  2591.         { !!! Delete this record for 7.0 only operation.
  2592.         This is really a private record so _DON'T_ use any other fields! }
  2593.         MAExpandMemRec        = RECORD
  2594.             emVersion:            integer;                { version of expanded memory }
  2595.             emSize:             LONGINT;                { length of em }
  2596.             emIntlGlobals:        LONGINT;                { international globals pointer }
  2597.             emKeyDeadState:     LONGINT;                { Key1Trans, Key2Trans dead state }
  2598.             emKeyCache:         Ptr;                    { KCHR keyboard cache }
  2599.             emIntlDef:            LONGINT;                { Reserved for Intl }
  2600.             emFirstKeyboard:    BOOLEAN;                { flag byte }
  2601.             emAlign:            BOOLEAN;                { long-align until we need this storage }
  2602.             emItlCache:            ARRAY [0..3] OF LONGINT; { bytes in cache }
  2603.             emItlNeedUnlock:    BOOLEAN;                { for pack6 }
  2604.             emItlDirectGetIntl: BOOLEAN;                { for pack6 }
  2605.             emFiller:            ARRAY [1..22] OF CHAR;    { Reserved room }
  2606.             END;
  2607.         MAExpandMemRecPtr    = ^MAExpandMemRec;
  2608.         MAExpandMemRecHandle    = ^MAExpandMemRecPtr;
  2609.  
  2610.     VAR
  2611.         keyCodeParameter:    integer;                    { See IM-V pp. 195 }
  2612.         virtualKey:         LONGINT;
  2613.         keyInfo:            LONGINT;
  2614.         theChar:            LONGINT;
  2615.         state:                LONGINT;
  2616.         keyTransTable:        Ptr;
  2617.  
  2618.     BEGIN
  2619.     INHERITED KeyEventToComponents(info);                { Get default translation, if any }
  2620.  
  2621.     IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
  2622.         BEGIN
  2623.         WITH info, thePEvent^ DO
  2624.             IF (what = keyDown) | (what = autoKey) THEN
  2625.                 BEGIN
  2626.                 { Now see if the command key is down.  If it is, get the correct ASCII translation
  2627.                 by masking the command key out and re-translating because the command key will mask
  2628.                 the shift modifier. }
  2629.  
  2630.                 IF theCmdKey THEN
  2631.                     BEGIN
  2632.                     { set the upkey bit so KeyTrans doesn't do special deadkey processing }
  2633.                     keyCodeParameter := BOR(BOR(BAND(modifiers, kMaskModifier), theKeyCode), kUpKeyMask);
  2634.  
  2635.                     state := 0;
  2636.  
  2637.                     { Get the correct keytable pointer.  We don't want to grope the system unnecessarily
  2638.                     so use the script managers improvements if they're there. }
  2639.                     IF gConfiguration.systemVersion >= $700 THEN
  2640.                         keyTransTable := Ptr(GetEnvirons(kMAsmKeyCache))
  2641.                     ELSE
  2642.                     { Fake handle.  the lomem address is a pointer to the table }
  2643.                         keyTransTable := Ptr(MAExpandMemRecHandle(ExpandMem)^^.emKeyCache);
  2644.  
  2645.                     keyInfo := KeyTrans(keyTransTable, keyCodeParameter, state);
  2646.  
  2647.                     theCharacter := chr(BAND(keyInfo, kMaskASCII1));
  2648.                     IF theCharacter = chr(0) THEN
  2649.                         theCharacter := chr(BSR(BAND(keyInfo, kMaskASCII2), 16));
  2650.                     END;
  2651.                 END;
  2652.  
  2653.         END;
  2654.     END;
  2655.  
  2656. {--------------------------------------------------------------------------------------------------}
  2657. {$S MAOpen}
  2658.  
  2659. FUNCTION TApplication.KindOfDocument(itsCmdNumber: CmdNumber;
  2660.                                      itsAppFilePtr: AppFilePtr): CmdNumber;
  2661.  
  2662.     BEGIN
  2663.     KindOfDocument := itsCmdNumber;
  2664.     END;
  2665.  
  2666. {--------------------------------------------------------------------------------------------------}
  2667. {$S MAInit}
  2668.  
  2669. PROCEDURE TApplication.LaunchClipboard;
  2670.  
  2671.     BEGIN
  2672.     AbsorbScrapStuff;                                    { Get current scrapCount as a baseline }
  2673.     ReadFromDeskScrap;
  2674.     END;
  2675.  
  2676. {--------------------------------------------------------------------------------------------------}
  2677. {$S MAApplicationRes}                                    { must be in the main segment }
  2678.  
  2679. PROCEDURE TApplication.MainEventLoop;
  2680.  
  2681.     BEGIN
  2682.     gIdlePhase := idleBegin;
  2683.     REPEAT
  2684.         IF gIdlePhase = idleBegin THEN
  2685.             UnloadAllSegments;                            { don't unload segs after idle has begun }
  2686.  
  2687.         { ??? should we
  2688.         (1) unload segs after completing idle but before doing the event?
  2689.         (2) unload segs while processing event during background printing? }
  2690.  
  2691.         PollEvent(kAllowApplicationToSleep);
  2692.     UNTIL gAppDone;                                     { gAppDone is a global BOOLEAN; that we set
  2693.                                                          TRUE when the user chooses 'Quit' }
  2694.     END;
  2695.  
  2696. {--------------------------------------------------------------------------------------------------}
  2697. {$S MAInit}
  2698.  
  2699. FUNCTION TApplication.MakeClipboardWindow: TWindow;
  2700.  
  2701.     VAR
  2702.         aDeskScrapView:     TDeskScrapView;
  2703.  
  2704.     BEGIN
  2705.     IF qTemplateViews THEN
  2706.         MakeClipboardWindow := NewTemplateWindow(kIDClipWindow, NIL)
  2707.     ELSE
  2708.         BEGIN
  2709.         New(aDeskScrapView);
  2710.         FailNil(aDeskScrapView);
  2711.         aDeskScrapView.IDeskScrapView;
  2712.         aDeskScrapView.fIdentifier := KIDClipView;
  2713.         MakeClipboardWindow := NewSimpleWindow(kIDClipWindow, TRUE, TRUE, NIL, aDeskScrapView);
  2714.         END;
  2715.     END;
  2716.  
  2717. {--------------------------------------------------------------------------------------------------}
  2718. {$S MAClipboard}
  2719.  
  2720. FUNCTION TApplication.MakeViewForAlienClipboard: TView;
  2721.  
  2722.     BEGIN
  2723.  { If the application doesn't override this then we just set the
  2724.   clipboard view to the orphanage, which handles TEXT and PICT
  2725.   scraps in a standard way. }
  2726.     MakeViewForAlienClipboard := gClipOrphanage;
  2727.     END;
  2728.  
  2729. {--------------------------------------------------------------------------------------------------}
  2730. {$S MASelCommand}
  2731.  
  2732. FUNCTION TApplication.MenuEvent(menuItem: LONGINT): TCommand;
  2733.  
  2734.     VAR
  2735.         fi:                 FailInfo;
  2736.         cmd:                CmdNumber;
  2737.         deskAccName:        Str255;
  2738.         theMenuNumber:        integer;
  2739.         theItemNumber:        integer;
  2740.  
  2741.     PROCEDURE HdlMenuEvt(error: OSErr;
  2742.                          message: LONGINT);
  2743.  
  2744.         BEGIN
  2745.         IF gSysWindowActive THEN
  2746.             ActivateBusyCursor(FALSE);
  2747.  
  2748.         FailNewMessage(error, message, BuildMessage(cmd, msgCmdErr));
  2749.         END;
  2750.  
  2751.     BEGIN
  2752.     MenuEvent := NIL;
  2753.  
  2754.     theMenuNumber := HiWrd(menuItem);
  2755.     theItemNumber := LoWrd(menuItem);
  2756.  
  2757.     IF theMenuNumber <> 0 THEN
  2758.         BEGIN
  2759.  
  2760.         cmd := CmdFromMenuItem(theMenuNumber, theItemNumber);
  2761.  
  2762.         {$IFC qDebug}
  2763.         IF cmd = cCantUndo THEN
  2764.             BEGIN
  2765.             Writeln('Command number ', cCantUndo: 1, ' is reserved for MacApp.');
  2766.             ProgramBreak('Use of reserved command number.');
  2767.             END;
  2768.  
  2769.         IF gReportMenuChoices & (cmd > 0) THEN
  2770.             Writeln('Menu Choice Command Number = ', cmd: 1);
  2771.         {$ENDC qDebug}
  2772.  
  2773.         IF (cmd < 0) & (theMenuNumber = mApple) THEN
  2774.             BEGIN
  2775.             GetItem(MAGetMenu(mApple), theItemNumber, deskAccName);
  2776.             OpenDeskAccessory(deskAccName);
  2777.             END
  2778.         ELSE IF (cmd < cEditBase) | (cmd > cEditLast) | (NOT SystemEdit(cmd - cEditBase)) THEN
  2779.             BEGIN
  2780.             CatchFailures(fi, HdlMenuEvt);
  2781.  
  2782.             IF gSysWindowActive THEN
  2783.                 ActivateBusyCursor(TRUE);
  2784.  
  2785.             MenuEvent := gTarget.DoMenuCommand(cmd);
  2786.  
  2787.             IF gSysWindowActive THEN
  2788.                 ActivateBusyCursor(FALSE);
  2789.  
  2790.             Success(fi);
  2791.             END;
  2792.         END;
  2793.     END;
  2794.  
  2795. {--------------------------------------------------------------------------------------------------}
  2796. {$S MASelCommand}
  2797.  
  2798. PROCEDURE TApplication.OpenDeskAccessory(deskAccName: Str255);
  2799.  
  2800.     VAR
  2801.         aRefNum:            integer;
  2802.         drvrH:                Handle;
  2803.         theID:                integer;
  2804.         theType:            ResType;
  2805.         theName:            Str255;
  2806.         oldPerm:            BOOLEAN;
  2807.         ourHeap:            BOOLEAN;
  2808.         fi:                 FailInfo;
  2809.         err:                OSErr;
  2810.         savedPort:            GrafPtr;
  2811.  
  2812.     PROCEDURE HdlOpenDeskAcc(error: OSErr;
  2813.                              message: LONGINT);
  2814.  
  2815.         BEGIN
  2816.         IF aRefNum <> 0 THEN
  2817.             CloseDeskAcc(aRefNum);
  2818.  
  2819.         IF message = 0 THEN
  2820.             BEGIN
  2821.             gErrorParm3 := deskAccName;
  2822.             { Get rid of leading null character }
  2823.             IF ord(gErrorParm3[1]) = 0 THEN
  2824.                 Delete(gErrorParm3, 1, 1);
  2825.             END;
  2826.  
  2827.         FailNewMessage(error, message, msgOpenFailed);
  2828.         END;
  2829.  
  2830.     FUNCTION IsOpen(itsID: integer): BOOLEAN;
  2831.  
  2832.         VAR
  2833.             dceHnd:             DCtlhandle;
  2834.  
  2835.         BEGIN
  2836.         IsOpen := FALSE;
  2837.         IF (itsID >= 0) & (itsID < GetUnitNtryCnt) THEN
  2838.             BEGIN
  2839.             dceHnd := GetUTableBase^[itsID];
  2840.             IF (dceHnd <> NIL) & BTst(dceHnd^^.dCtlFlags, 5) THEN
  2841.                 IsOpen := TRUE;
  2842.             END;
  2843.         END;
  2844.  
  2845.     BEGIN
  2846.     CatchFailures(fi, HdlOpenDeskAcc);
  2847.     aRefNum := 0;                                        { Make sure failure handler works. }
  2848.  
  2849.     { Attempt to load the DA into memory.  If 'deskAccName' refers to another app }
  2850.     { rather than a real desk acc, then GetNamedResource returns a faked up handle }
  2851.     { courtesy of MultiFinder™. We open the DA with permanent allocation so as to }
  2852.     { ensure that we don't take space from our code segments.                       }
  2853.  
  2854.     oldPerm := PermAllocation(TRUE);
  2855.     drvrH := GetNamedResource('DRVR', deskAccName);
  2856.     IF PermAllocation(oldPerm) THEN;                    { discard result }
  2857.     FailNILResource(drvrH);                             { Either there wasn't enough memory }
  2858.     { …to load the DA, or something is }
  2859.     { …seriously wrong. }
  2860.  
  2861.     { At this point if we are really opening a DA we know it fits in memory.  }
  2862.  
  2863.     GetResInfo(drvrH, theID, theType, theName);         { If it's a not a real DA then this }
  2864.     { will generate a ResError.   }
  2865.     ourHeap := (HandleZone(drvrH) = ApplicZone) | OptionKeyIsDown;    { Find out which zone it 
  2866.                                                         lives in, or if option key is down. }
  2867.  
  2868.     IF (ResError <> noErr) |                            { If it's a MultiFinder fake DA, }
  2869.        IsOpen(theID) |                                    { …or if the DA is already open, }
  2870.        (NOT ourHeap) THEN                                { …or it's not going in our heap }
  2871.         BEGIN
  2872.         oldPerm := PermAllocation(TRUE);                { In case we guess wrong }
  2873.         GetPort(savedPort);
  2874.         aRefNum := OpenDeskAcc(deskAccName);            { …then go ahead and open it. }
  2875.         SetPort(savedPort);
  2876.         IF PermAllocation(oldPerm) THEN;                { discard result }
  2877.         END
  2878.  
  2879.     ELSE
  2880.  
  2881.         BEGIN
  2882.         { If we get this far, we know we have a real DA and it's going into our     }
  2883.         { heap.  Open it, but them make sure we have enough memory to continue }
  2884.         { running.    }
  2885.  
  2886.         FailSpaceIsLow;                                 { In case we're already low on mem. }
  2887.  
  2888.         oldPerm := PermAllocation(TRUE);                { If the pig wants to wallow }
  2889.         GetPort(savedPort);
  2890.         aRefNum := OpenDeskAcc(deskAccName);            { Use temporary allocation. }
  2891.         SetPort(savedPort);
  2892.         IF PermAllocation(oldPerm) THEN;                { discard result }
  2893.  
  2894.         FailSpaceIsLow;                                 { Fail if not enough memory left. }
  2895.         FailNil(drvrH^);                                { …or if the driver was purged to }
  2896.         { …satisfy a code space requirement.}
  2897.         END;
  2898.  
  2899.     Success(fi);
  2900.  
  2901.     END;
  2902.  
  2903. {--------------------------------------------------------------------------------------------------}
  2904. {$S MAOpen}
  2905.  
  2906. PROCEDURE TApplication.OpenNew(itsCmdNumber: CmdNumber);
  2907.  
  2908.     VAR
  2909.         aDocument:            TDocument;
  2910.         fi:                 FailInfo;
  2911.         newTitle:            Str255;
  2912.         aWindow:            TWindow;
  2913.  
  2914.     PROCEDURE HdlOpenNew(error: integer;
  2915.                          message: LONGINT);
  2916.  
  2917.         BEGIN
  2918.         FreeIfObject(aDocument);
  2919.         aDocument := NIL;
  2920.  
  2921.         FailNewMessage(error, message, msgNewFailed);
  2922.         END;
  2923.  
  2924.     BEGIN
  2925.     aDocument := NIL;
  2926.     CatchFailures(fi, HdlOpenNew);
  2927.  
  2928.     aDocument := DoMakeDocument(KindOfDocument(itsCmdNumber, NIL));
  2929.     aDocument.DoInitialState;
  2930.     aDocument.DoMakeViews(kForDisplay);
  2931.     aDocument.DoMakeWindows;
  2932.  
  2933.     aDocument.UntitledName(newTitle);
  2934.     { For MacApp 1.1, newTitle should be always <> '' }
  2935.     IF newTitle <> '' THEN
  2936.         aDocument.SetTitle(newTitle)
  2937.     ELSE IF (aDocument.fWindowList <> NIL) & (aDocument.fWindowList.GetSize > 0) THEN
  2938.     { Grope, grope, grope }
  2939.         BEGIN                                            { must set fTitle field anyways }
  2940.         aWindow := TWindow(aDocument.fWindowList.First);
  2941.  
  2942.         aWindow.GetTitle(newTitle);
  2943.         Handle(aDocument.fTitle) := DisposeIfHandle(aDocument.fTitle);
  2944.         aDocument.fTitle := NewString(Copy(newTitle, aWindow.fPreDocname, length(newTitle) -
  2945.                                            aWindow.fConstTitle));
  2946.         FailNil(aDocument.fTitle);
  2947.         END;
  2948.  
  2949.     AddDocument(aDocument);
  2950.  
  2951.     FailSpaceIsLow;                                     { Fail if document leaves us with no room }
  2952.  
  2953.     { Don't attempt to show the windows until we're sure we won't fail }
  2954.     aDocument.ShowWindows;
  2955.  
  2956.     Success(fi);
  2957.     END;
  2958.  
  2959. {--------------------------------------------------------------------------------------------------}
  2960. {$S MAOpen}
  2961.  
  2962. PROCEDURE TApplication.OpenOld(itsOpenCmd: CmdNumber;
  2963.                                anAppFile: AppFile);
  2964. { Called for opening a document, given its name }
  2965.  
  2966.     VAR
  2967.         aDocument:            TDocument;
  2968.         otherDoc:            TDocument;
  2969.         oldCodeReserve, oldMemReserve: Size;
  2970.         fi:                 FailInfo;
  2971.  
  2972.     PROCEDURE HdlOpenOld(error: integer;
  2973.                          message: LONGINT);
  2974.  
  2975.         BEGIN
  2976.         FreeIfObject(aDocument);
  2977.         aDocument := NIL;
  2978.  
  2979.         IF message = 0 THEN
  2980.             gErrorParm3 := anAppFile.fName;
  2981.         { Set the reserve back to where it was }
  2982.         SetReserveSize(oldCodeReserve, oldMemReserve);
  2983.         FailNewMessage(error, message, msgOpenFailed);
  2984.         END;
  2985.  
  2986.     BEGIN
  2987.     aDocument := NIL;
  2988.  
  2989.     CatchFailures(fi, HdlOpenOld);
  2990.  
  2991.     { Set reserve down a little to ensure that we can open existing documents }
  2992.     GetReserveSize(oldCodeReserve, oldMemReserve);
  2993.     SetReserveSize(oldCodeReserve, oldMemReserve DIV 2);
  2994.  
  2995.     otherDoc := AlreadyOpen(anAppFile.fName, anAppFile.vRefnum);
  2996.     IF otherDoc <> NIL THEN
  2997.         otherDoc.OpenAgain(itsOpenCmd, aDocument);
  2998.  
  2999.     aDocument := DoMakeDocument(KindOfDocument(itsOpenCmd, @anAppFile));
  3000.  
  3001.     aDocument.ReadFromFile(anAppFile, kForDisplay);
  3002.     aDocument.DoMakeViews(kForDisplay);
  3003.     aDocument.DoMakeWindows;
  3004.  
  3005.     AddDocument(aDocument);
  3006.  
  3007.     FailSpaceIsLow;                                     { Fail if the document leaves us with no
  3008.                                                          memory }
  3009.     { Set the reserve back to where it was }
  3010.     SetReserveSize(oldCodeReserve, oldMemReserve);
  3011.  
  3012.     { Don't attempt to show the windows until we're sure we won't fail }
  3013.     aDocument.ShowWindows;
  3014.  
  3015.     Success(fi);
  3016.     END;
  3017.  
  3018. {--------------------------------------------------------------------------------------------------}
  3019. {$S MAApplicationRes}
  3020.  
  3021. PROCEDURE TApplication.PerformCommand(command: TCommand);
  3022.  
  3023.     VAR
  3024.         fi:                 FailInfo;
  3025.         saveCmd:            BOOLEAN;
  3026.         {$IFC qDebug}
  3027.         aMAName:            MAName;
  3028.         {$ENDC}
  3029.  
  3030.     PROCEDURE HdlDoit(error: integer;
  3031.                       message: LONGINT);
  3032.  
  3033.         VAR
  3034.             aCmdNumber:         integer;
  3035.  
  3036.         BEGIN
  3037.         IF gClipClaimed THEN
  3038.             BEGIN
  3039.             SetClipView(gClipUndoView);
  3040.             gClipUndoView := NIL;
  3041.             { The newly-installed view needs to be freed also }
  3042.             { SwapClipViews;}                            { Get original back there… !!! would be nice
  3043.                                                          but doesn't do right thing yet }
  3044.             END;
  3045.  
  3046.         aCmdNumber := command.fCmdNumber;
  3047.         IF command.fFreeOnCompletion THEN
  3048.             FreeIfObject(command);
  3049.  
  3050.         IF command = fLastCommand THEN
  3051.             fLastCommand := NIL;                        { make sure we clear our reference }
  3052.  
  3053.         FailNewMessage(error, message, BuildMessage(aCmdNumber, msgCmdErr));
  3054.         END;
  3055.  
  3056.     BEGIN
  3057.     IF qDebug & (command = NIL) THEN
  3058.         ProgramBreak('NIL passed to TApplication.PerformCommand')
  3059.     ELSE IF qDebug & (NOT IsObject(command)) THEN        { since it's possible to have passed in a
  3060.                                                          freed undoable command allocated in a
  3061.                                                          global variable (due to pilot error) }
  3062.         BEGIN
  3063.         IF VerboseIsobject(command) THEN;
  3064.         ProgramBreak('bogus object passed to TApplication.PerformCommand');
  3065.         END
  3066.     ELSE
  3067.         BEGIN
  3068.         {$IFC qDebug}
  3069.         IF gIntenseDebugging THEN
  3070.             BEGIN
  3071.             command.GetClassName(aMAName);
  3072.             Writeln('The Command to perform: ', aMAName);
  3073.             PLFlush(output);
  3074.             END;
  3075.         {$ENDC}
  3076.  
  3077.         IF command.fTracksMouse THEN
  3078.             BEGIN
  3079.             {$IFC qDebug}
  3080.             IF gIntenseDebugging THEN
  3081.                 IF (command <> NIL) THEN
  3082.                     BEGIN
  3083.                     command.GetClassName(aMAName);
  3084.                     Writeln('Tracking Command: ', aMAName);
  3085.                     PLFlush(output);
  3086.                     END;
  3087.             {$ENDC}
  3088.             IF gEventLevel = 1 THEN                     { Don't unload segs if in nested event
  3089.                                                          handling }
  3090.                 UnloadAllSegments;
  3091.  
  3092.             command := TrackMouse(command.fInitialPt, gStdHysteresis, command);
  3093.             END;
  3094.  
  3095.         IF (command <> NIL) THEN
  3096.             BEGIN
  3097.  
  3098.             saveCmd := command.fCausesChange | command.fCanUndo;
  3099.  
  3100.             IF saveCmd THEN
  3101.                 BEGIN
  3102.                 CommitLastCommand;                        { it frees fLastCommand. If the last
  3103.                                                          (fCausesChange or fCanUndo) command sets
  3104.                                                          fFreeOnCompletion to FALSE then we can
  3105.                                                          execute the same undoable command any
  3106.                                                          number of times. Non-Undoable commands
  3107.                                                          don't get FREEd here but immediately after
  3108.                                                          they're executed (that's performed… not
  3109.                                                          shot) }
  3110.  
  3111.                 IF qDebug & NOT IsObject(command) THEN
  3112.                     BEGIN
  3113.                     IF VerboseIsobject(command) THEN;
  3114.                     ProgramBreak('You may not want to continue with a command that''s been _FREED_!'
  3115.                                  );
  3116.                     END;
  3117.                 END;
  3118.  
  3119.             CatchFailures(fi, HdlDoit);
  3120.             IF gEventLevel = 1 THEN                     { Don't unload segs if in nested event
  3121.                                                          handling }
  3122.                 UnloadAllSegments;
  3123.  
  3124.             gClipClaimed := FALSE;
  3125.  
  3126.             command.DoIt;
  3127.             Success(fi);
  3128.  
  3129.             IF saveCmd THEN
  3130.                 BEGIN
  3131.                 fLastCommand := command;
  3132.                 command.fCmdDone := TRUE;
  3133.                 END;
  3134.  
  3135.             WITH command DO
  3136.                 IF fCausesChange THEN                    { put this after .DoIt, so .DoIt can change
  3137.                                                          this flag }
  3138.                     BEGIN
  3139.                     IF fChangedDocument <> NIL THEN
  3140.                         WITH fChangedDocument DO
  3141.                             SetChangeCount(Max(GetChangeCount + 1, 1)); { protect from rollover (it
  3142.                                                                          goes negative). If your
  3143.                                                                          document has this many
  3144.                                                                          changes (over 2 billion
  3145.                                                                          you are truly sick!}
  3146.                     END;
  3147.  
  3148.             IF NOT saveCmd & command.fFreeOnCompletion THEN
  3149.                 FreeIfObject(command);
  3150.             END;
  3151.         END;
  3152.     END;
  3153.  
  3154. {--------------------------------------------------------------------------------------------------}
  3155. {$S MAApplicationRes}
  3156.  
  3157. PROCEDURE TApplication.PollEvent(allowApplicationToSleep: BOOLEAN);
  3158.  
  3159.     LABEL 1000;
  3160.  
  3161.     VAR
  3162.         fi:                 FailInfo;
  3163.         theEvent:            EventRecord;
  3164.         aWindow:            TWindow;
  3165.         commandToPerform:    TCommand;
  3166.         waitTicks:            LONGINT;
  3167.         idledBeforeEventCall: BOOLEAN;
  3168.  
  3169.     PROCEDURE HdlPollEvt(error: integer;
  3170.                          message: LONGINT);
  3171.  
  3172.         BEGIN
  3173.         {$IFC qDebug}
  3174.         Writeln;                                        { add a blank line after all the messages
  3175.                                                          from Failure }
  3176.         {$ENDC}
  3177.         gEventLevel := gEventLevel - 1;
  3178.         IF gEventLevel = 0 THEN
  3179.             BEGIN
  3180.             IF error <> noErr THEN
  3181.                 BEGIN
  3182.                 UnloadAllSegments;
  3183.                 ShowError(error, message);
  3184.                 END;
  3185.  
  3186.             HiliteMenu(0);                                { Make sure menus get straightened out. }
  3187.             InvalidateMenus;
  3188.  
  3189.             GOTO 1000;                                    { Keep the application running. }
  3190.             END;
  3191.         END;
  3192.  
  3193.     BEGIN
  3194.     gEventLevel := gEventLevel + 1;
  3195.  
  3196.     {$IFC qDebug}
  3197.     IF gTarget = NIL THEN
  3198.         Writeln('Serious Error!!! in TApplication.PollEvent: target = NIL');
  3199.     {$ENDC}
  3200.  
  3201.     CatchFailures(fi, HdlPollEvt);
  3202.  
  3203.     { IF we have any queued commands that have not otherwise been taken care of, now is the time. }
  3204.  
  3205.     commandToPerform := GetNextCommand;
  3206.     IF commandToPerform <> NIL THEN
  3207.         PerformCommand(commandToPerform)
  3208.     ELSE
  3209.         BEGIN
  3210.         { If we're running with WaitNextEvent then if there are no events pending we should
  3211.         idle before calling WaitNextEvent.    This is because we may not come back from WaitNextEvent
  3212.         for an indeterminate period of time.  By idling we make sure the menu bar is correct and
  3213.         give the app a chance to reset the idle frequency and cursor region.}
  3214.  
  3215.         IF (qNeedsWaitNextEvent | gConfiguration.hasWaitNextEvent) & (allowApplicationToSleep &
  3216.            (fTicksTilNextIdle > 0)) & (NOT EventAvail(gMainEventMask, theEvent)) & (gIdlePhase =
  3217.            idleBegin) THEN
  3218.             BEGIN
  3219.             Idle(gIdlePhase);
  3220.             gIdlePhase := idleContinue;
  3221.             idledBeforeEventCall := TRUE;
  3222.             END
  3223.         ELSE
  3224.             idledBeforeEventCall := FALSE;
  3225.  
  3226.         { If the cursor region is invalid, force it's recalculation before going to WNE. It won't be
  3227.         calculated from idle in the WNE case unless gAlwaysTrackCursor is true. }
  3228.         IF (qNeedsWaitNextEvent | gConfiguration.hasWaitNextEvent) & (EmptyRgn(gCursorRgn)) THEN
  3229.             BEGIN
  3230.             IF TrackCursor THEN;
  3231.             END;
  3232.  
  3233.         IF allowApplicationToSleep THEN
  3234.             waitTicks := fTicksTilNextIdle
  3235.         ELSE
  3236.             waitTicks := 0;
  3237.  
  3238.         HiliteMenu(0);
  3239.  
  3240.         IF GetEvent(gMainEventMask, waitTicks, gCursorRgn, theEvent) THEN
  3241.             BEGIN
  3242.             IF gIdlePhase <> idleBegin THEN
  3243.                 BEGIN
  3244.                 Idle(idleEnd);
  3245.                 gIdlePhase := idleBegin;
  3246.                 END;
  3247.             HandleEvent(theEvent);
  3248.             {$IFC qDebug}
  3249.             gErrorParm3 := '?????';                     { to prevent anyone from using old values }
  3250.             {$ENDC}
  3251.             END
  3252.  
  3253.         ELSE IF NOT idledBeforeEventCall | (fTicksTilNextIdle = 0) THEN { idle if we Neeeed to! }
  3254.             BEGIN
  3255.             Idle(gIdlePhase);
  3256.             gIdlePhase := idleContinue;
  3257.             END;
  3258.         END;
  3259.  
  3260.  { The desk scrap may have been changed by use of Cmd-X or Cmd-C in
  3261.   desk accessories. }
  3262.     IF gSysWindowActive THEN
  3263.         BEGIN
  3264.         CheckDeskScrap;
  3265.         InvalidateFocus;
  3266.         END;
  3267.  
  3268.     Success(fi);
  3269.     gEventLevel := gEventLevel - 1;
  3270.  
  3271.     IF gEventLevel = 0 THEN
  3272.         gInhibitNestedHandling := FALSE;                { All clear }
  3273.  
  3274. 1000:                                                    { Failure re-entry point }
  3275.     END;
  3276.  
  3277. {--------------------------------------------------------------------------------------------------}
  3278. {$S MAApplicationRes}
  3279.  
  3280. PROCEDURE TApplication.PostCommand(command: TCommand);
  3281.  
  3282.     BEGIN
  3283.     fCommandQueue.Insert(command);                        { inserts command ordered the list }
  3284.     END;
  3285.  
  3286. {--------------------------------------------------------------------------------------------------}
  3287. {$S MAApplicationRes}
  3288.  
  3289. PROCEDURE TApplication.PostHandleEvent(VAR theEventInfo: EventInfo);
  3290.  
  3291.     VAR
  3292.         sysWindowAct:        BOOLEAN;
  3293.         perm:                BOOLEAN;
  3294.  
  3295.     BEGIN
  3296.     IF theEventInfo.affectsMenus THEN
  3297.         InvalidateMenus;
  3298.  
  3299.     perm := PermAllocation(FALSE);
  3300.     {$IFC qDebug}
  3301.     IF perm THEN
  3302.         ProgramBreak('The permanent flag was left TRUE.');
  3303.     {$ENDC}
  3304.  
  3305.     { See if a system window has been activated or deactivated. }
  3306.     sysWindowAct := IsDeskAccessory(FrontWindow);
  3307.  
  3308.     IF sysWindowAct <> gSysWindowActive THEN
  3309.         BEGIN
  3310.         gSysWindowActive := sysWindowAct;
  3311.  
  3312.         IF gSysWindowActive THEN                        { deactivating to sys window }
  3313.             BEGIN
  3314.             AboutToLoseControl(TRUE);
  3315.             InvalidateMenuBar;
  3316.             END
  3317.         ELSE                                            { coming back from sys window }
  3318.             RegainControl(TRUE);
  3319.         END;
  3320.  
  3321.     END;
  3322.  
  3323. {--------------------------------------------------------------------------------------------------}
  3324. {$S MAFinder}
  3325.  
  3326. FUNCTION TApplication.PrintDocument(anAppFile: AppFile): BOOLEAN;
  3327.  
  3328.     VAR
  3329.         aDocument:            TDocument;
  3330.         aPrintHandler:        TPrintHandler;
  3331.         proceed:            BOOLEAN;
  3332.         fi:                 FailInfo;
  3333.  
  3334.     PROCEDURE HdlPrintDoc(error: integer;
  3335.                           message: LONGINT);
  3336.  
  3337.         BEGIN
  3338.         FreeIfObject(aDocument);
  3339.         aDocument := NIL;
  3340.         END;
  3341.  
  3342.     BEGIN
  3343.     aDocument := NIL;
  3344.     CatchFailures(fi, HdlPrintDoc);
  3345.  
  3346.     aDocument := DoMakeDocument(KindOfDocument(cFinderPrint, @anAppFile));
  3347.     aDocument.ReadFromFile(anAppFile, kForPrinting);
  3348.     aDocument.DoMakeViews(kForPrinting);
  3349.  
  3350.     { Note that if we are finder printing, this segment will be resident }
  3351.     UnloadAllSegments;
  3352.  
  3353.     aPrintHandler := aDocument.fDocPrintHandler;
  3354.     IF aPrintHandler <> NIL THEN
  3355.         BEGIN
  3356.         proceed := aPrintHandler.SetupForFinder;
  3357.         IF proceed & (aPrintHandler.Print(cFinderPrint, proceed) <> NIL) THEN
  3358.         {$IFC qDebug}
  3359.             ProgramBreak('TApplication.PrintDocument: Print return a real command.')
  3360.             {$ENDC} ;
  3361.         END
  3362.     ELSE
  3363.         BEGIN
  3364.         proceed := TRUE;                                { might as well try the next one }
  3365.         {$IFC qDebug}
  3366.         ProgramBreak('TApplication.PrintDocument: The document’s fDocPrintHandler is NIL.');
  3367.         {$ENDC}
  3368.         END;
  3369.  
  3370.     UnloadAllSegments;
  3371.     Success(fi);
  3372.  
  3373.     FreeIfObject(aDocument);
  3374.     aDocument := NIL;
  3375.  
  3376.     UnloadAllSegments;
  3377.     PrintDocument := proceed;
  3378.     END;
  3379.  
  3380. {--------------------------------------------------------------------------------------------------}
  3381. {$S MAClipboard}
  3382.  
  3383. PROCEDURE TApplication.ReadFromDeskScrap;
  3384.  
  3385.     LABEL 1000;
  3386.  
  3387.     VAR
  3388.         aViewForClipboard:    TView;
  3389.         fi:                 FailInfo;
  3390.  
  3391.     PROCEDURE HdlMakeViewForAlienClipbd(error: OSErr;
  3392.                                         message: LONGINT);
  3393.  
  3394.         BEGIN
  3395.  
  3396.         aViewForClipboard := gClipOrphanage;
  3397.         IF message = 0 THEN
  3398.             message := msgImportClipFailed;
  3399.         ShowError(error, message);
  3400.         GOTO 1000;
  3401.         END;
  3402.  
  3403.     BEGIN
  3404.     CatchFailures(fi, HdlMakeViewForAlienClipbd);
  3405.     aViewForClipboard := MakeViewForAlienClipboard;
  3406.     FailNil(aViewForClipboard);
  3407.     Success(fi);
  3408. 1000:
  3409.     ClaimClipboard(aViewForClipboard);
  3410.     END;
  3411.  
  3412. {--------------------------------------------------------------------------------------------------}
  3413. {$S MAApplicationRes}
  3414.  
  3415. PROCEDURE TApplication.RegainControl(checkClipboard: BOOLEAN);
  3416.  
  3417.     BEGIN
  3418.     ActivateBusyCursor(TRUE);
  3419.     IF checkClipboard THEN
  3420.         CheckDeskScrap;
  3421.     END;
  3422.  
  3423. {--------------------------------------------------------------------------------------------------}
  3424. {$S MADebug}
  3425. { Debugging procedure: given an EventRecord, prints out information about the event. }
  3426.  
  3427. PROCEDURE TApplication.ReportEvent(VAR theEvent: EventRecord);
  3428.  
  3429.     VAR
  3430.         ch:                 integer;
  3431.         cap:                integer;
  3432.         aString:            Str255;
  3433.         mods:                STRING[10];
  3434.         aWMgrWindow:        WindowPtr;
  3435.  
  3436.     BEGIN
  3437.     WITH theEvent DO
  3438.         BEGIN
  3439.         WRITE('t = ', when);
  3440.         mods := '          ';
  3441.         { 1234567890 } ;
  3442.  
  3443.         IF BAND(modifiers, controlKey) <> 0 THEN
  3444.             mods[2] := 'C';
  3445.         IF BAND(modifiers, optionKey) <> 0 THEN
  3446.             mods[3] := 'O';
  3447.         IF BAND(modifiers, alphaLock) <> 0 THEN
  3448.             mods[4] := 'L';
  3449.         IF BAND(modifiers, shiftKey) <> 0 THEN
  3450.             mods[5] := 'S';
  3451.         IF BAND(modifiers, cmdKey) <> 0 THEN
  3452.             mods[6] := 'C';
  3453.         IF BAND(modifiers, btnState) <> 0 THEN
  3454.             mods[7] := 'M';
  3455.         IF what = activateEvt THEN
  3456.             IF BAND(modifiers, activeFlag) <> 0 THEN
  3457.                 mods[8] := 'A'
  3458.             ELSE
  3459.                 mods[8] := 'D';
  3460.         WRITE(mods);
  3461.  
  3462.         CASE what OF
  3463.             nullEvent:
  3464.                 Writeln('nullEvent   ');
  3465.             mouseDown, mouseUp:
  3466.                 BEGIN
  3467.                 IF what = mouseDown THEN
  3468.                     WRITE('mouseDown   ')
  3469.                 ELSE
  3470.                     WRITE('mouseUp     ');
  3471.                 WRITE('@ (', where.h: 1, ', ', where.v: 1, ')');
  3472.                 CASE FindWindow(where, aWMgrWindow) OF
  3473.                     inMenuBar:
  3474.                         aString := 'inMenuBar';
  3475.                     inSysWindow:
  3476.                         aString := 'inSysWindow';
  3477.                     inDrag:
  3478.                         aString := 'inDrag';
  3479.                     inGrow:
  3480.                         aString := 'inGrow';
  3481.                     inGoAway:
  3482.                         aString := 'inGoAway';
  3483.                     inContent:
  3484.                         aString := 'inContent';
  3485.                     inZoomIn:
  3486.                         aString := 'inZoomIn';
  3487.                     inZoomOut:
  3488.                         aString := 'inZoomOut';
  3489.                     OTHERWISE
  3490.                         aString := 'Mouse clicked in an unknown place.'
  3491.                 END;
  3492.                 Writeln(' ': 5, aString);
  3493.                 END;
  3494.             keyDown, autoKey, keyUp:
  3495.                 BEGIN
  3496.                 IF what = keyDown THEN
  3497.                     WRITE('keyDown     ')
  3498.                 ELSE IF what = autoKey THEN
  3499.                     WRITE('autoKey     ')
  3500.                 ELSE
  3501.                     WRITE('keyUp       ');
  3502.  
  3503.                 ch := BAND(message, charCodeMask);
  3504.                 cap := BSR(message, 8);
  3505.  
  3506.                 IF (ch >= $20) & (ch <= $D8) & (ch <> $7F) THEN
  3507.                     WRITE('"', chr(ch), '"')
  3508.                 ELSE
  3509.                     WRITE('   ');
  3510.  
  3511.                 Writeln('(', ch: 1, '/', cap: 1, ')');
  3512.                 END;
  3513.             updateEvt, activateEvt:
  3514.                 BEGIN
  3515.                 IF what = updateEvt THEN
  3516.                     WRITE('updateEvt   ')
  3517.                 ELSE
  3518.                     WRITE('activateEvt ');
  3519.  
  3520.                 aString := WindowPeek(message)^.titleHandle^^;
  3521.                 Writeln('"', aString, '"');
  3522.                 END;
  3523.             diskEvt:
  3524.                 Writeln('diskEvt     ', 'd = ', LoWord(message): 1, ' e = ', HiWord(message): 1);
  3525.             networkEvt:
  3526.                 BEGIN
  3527.                 WRITE('networkEvt  ');
  3528.                 WritePtr(message);
  3529.                 Writeln;
  3530.                 END;
  3531.             driverEvt:
  3532.                 BEGIN
  3533.                 WrLblHexLongInt('driverEvt   , message', message);
  3534.                 Writeln;
  3535.                 END;
  3536.             app1Evt:
  3537.                 BEGIN
  3538.                 WrLblHexLongInt('app1Evt     , message', message);
  3539.                 Writeln;
  3540.                 END;
  3541.             app2Evt:
  3542.                 BEGIN
  3543.                 WrLblHexLongInt('app2Evt     , message', message);
  3544.                 Writeln;
  3545.                 END;
  3546.             app3Evt:
  3547.                 BEGIN
  3548.                 WrLblHexLongInt('app3Evt     , message', message);
  3549.                 Writeln;
  3550.                 END;
  3551.             app4Evt:
  3552.                 BEGIN
  3553.                 CASE BSR(BAND(message, $FF000000), 24) OF
  3554.                     kSuspendOrResume:
  3555.                         IF Odd(message) THEN
  3556.                             WRITE('resume      ')
  3557.                         ELSE
  3558.                             WRITE('suspend     ');
  3559.                     kMouseMovedMessage:
  3560.                         WRITE('mouse moved ');
  3561.                     OTHERWISE
  3562.                         WRITE('app4Evt     ');
  3563.                 END;
  3564.                 WrLblHexLongInt(', message', message);
  3565.                 Writeln;
  3566.                 END;
  3567.             OTHERWISE
  3568.                 BEGIN
  3569.                 Writeln('??? unknown = ', what: 1, '   ');
  3570.                 WriteHexLongInt(message);
  3571.                 END;
  3572.         END;
  3573.         END;
  3574.     END;
  3575.  
  3576. {--------------------------------------------------------------------------------------------------}
  3577. {$S MAApplicationRes}                                    { must be in the main segment }
  3578.  
  3579. PROCEDURE TApplication.Run;
  3580.  
  3581.     VAR
  3582.         findSeg:            integer;
  3583.  
  3584.     BEGIN
  3585.     UnloadAllSegments;
  3586.     FailSpaceIsLow;                                     { make sure we have enough memory to
  3587.                                                          continue }
  3588.     gInitialized := TRUE;                                { was set FALSE in InitToolBox }
  3589.  
  3590.     IF gFinderPrinting THEN
  3591.         BEGIN
  3592.         findSeg := GetSegNumber(@FinderSegProc);
  3593.  
  3594.         UnloadAllSegments;
  3595.         SetResidentSegment(findSeg, TRUE);
  3596.  
  3597.         HandleFinderRequest;
  3598.  
  3599.         SetResidentSegment(findSeg, FALSE);
  3600.         UnloadAllSegments;
  3601.  
  3602.         gEventLevel := 0;                                { Indicate outermost level }
  3603.         Close;                                            { Close is always called when quitting app }
  3604.         END
  3605.     ELSE
  3606.         BEGIN
  3607.         LaunchClipboard;
  3608.  
  3609.         UnloadAllSegments;
  3610.         HandleFinderRequest;
  3611.  
  3612.         UnloadAllSegments;
  3613.         gEventLevel := 0;                                { Indicate outermost level }
  3614.         MainEventLoop;
  3615.  
  3616.         AboutToLoseControl(TRUE);
  3617.         END;
  3618.  
  3619.     {$IFC qDebug}
  3620.     { See if previous max. resource usage has been exceeded by the termi-
  3621.     nation code and resources. }
  3622.     CheckRsrcUsage;
  3623.     {$ENDC}
  3624.  
  3625.     { We must call CleanupMacApp here; if we wait to fall thru to the end of the
  3626.     main program, A5 has been invalidated and we can't refer to any globals. }
  3627.     CleanupMacApp;
  3628.     END;
  3629.  
  3630. {--------------------------------------------------------------------------------------------------}
  3631. {$S MAApplicationRes}
  3632.  
  3633. PROCEDURE TApplication.SelectWMgrWindow(aWMgrWindow: WindowPtr);
  3634.  
  3635.     BEGIN
  3636.     SelectWindow(aWMgrWindow);                            { Simply call the toolbox to select it. }
  3637.     gLastClickPart := inDesk;                            { Make sure previous mouse clicks are not }
  3638.     { are not considered part of a multi-click. }
  3639.     END;
  3640.  
  3641. {--------------------------------------------------------------------------------------------------}
  3642. {$S MAClipboard}
  3643.  
  3644. PROCEDURE TApplication.SetClipView(clipView: TView);
  3645.  
  3646.     VAR
  3647.         theSuperView:        TView;
  3648.  
  3649.     PROCEDURE RemoveView(aView: TView);
  3650.  
  3651.         BEGIN
  3652.         theSuperView.RemoveSubView(aView);
  3653.         END;
  3654.  
  3655.     BEGIN
  3656.     IF gClipWindow <> NIL THEN
  3657.         BEGIN
  3658.         IF gClipWindow.CountSubViews > 0 THEN
  3659.             theSuperView := TView(gClipWindow.fSubViews.First)
  3660.         ELSE
  3661.             theSuperView := gClipWindow;
  3662.         theSuperView.EachSubView(RemoveView);
  3663.         theSuperView.AddSubView(clipView);
  3664.         clipView.fSuperView := theSuperView;
  3665.         clipView.SuperViewChangedSize(gZeroVPt, kDontInvalidate);
  3666.         clipView.RevealTop(kDontRedraw);
  3667.         gClipWindow.ForceRedraw;
  3668.         gClipWindow.SetTarget(gClipWindow);
  3669.         gClipWrittenToDeskScrap := clipView = gClipOrphanage;
  3670.         END
  3671.     ELSE
  3672.         BEGIN
  3673.         {$IFC qDebug}
  3674.         ProgramBreak('SetClipView in absence of gClipWindow');
  3675.         {$ENDC}
  3676.         END;
  3677.  
  3678.     clipView.ViewEnable(FALSE, kDontRedraw);            {Ignore clicks while in clipboard views}
  3679.     gClipView := clipView;
  3680.     END;
  3681.  
  3682. {--------------------------------------------------------------------------------------------------}
  3683. {$S MAApplicationRes}
  3684.  
  3685. PROCEDURE TApplication.SetTarget(newTarget: TEvtHandler);
  3686.  
  3687.     BEGIN
  3688.     {$Ifc qDebug}
  3689.     IF newTarget = NIL THEN
  3690.         ProgramBreak('In TApplication.SetTarget…  you''re setting the global target to nil!');
  3691.     {$Endc}
  3692.     IF newTarget <> gTarget THEN
  3693.         BEGIN
  3694.         gTarget.InstallSelection(TRUE, FALSE);
  3695.         newTarget.InstallSelection(FALSE, TRUE);
  3696.         gTarget := newTarget;
  3697.         fTicksTilNextIdle := 0;                         { Make sure we idle ASAP because there's a
  3698.                                                          new target. }
  3699.         InvalidateCursorRgn;
  3700.         END;
  3701.     END;
  3702.  
  3703. {--------------------------------------------------------------------------------------------------}
  3704. {$S MAApplicationRes}
  3705.  
  3706. PROCEDURE TApplication.SetUndoText(cmdDone: BOOLEAN;
  3707.                                    aCmdNumber: CmdNumber);
  3708.  
  3709.     VAR
  3710.         newMenuState:        integer;
  3711.         undoName:            Str255;
  3712.         cmdName:            Str255;
  3713.         preCmdName:         integer;
  3714.         constChars:         integer;
  3715.  
  3716.     BEGIN
  3717.     IF (gUndoState <> cmdDone) | (gUndoCmd <> aCmdNumber) THEN
  3718.         BEGIN
  3719.         IF aCmdNumber = cCantUndo THEN
  3720.             newMenuState := bzCantUndo
  3721.         ELSE IF cmdDone THEN
  3722.             newMenuState := bzUndo
  3723.         ELSE
  3724.             newMenuState := bzRedo;
  3725.  
  3726.         GetIndString(undoName, kIDBuzzString, newMenuState);
  3727.         IF ParseTitleTemplate(undoName, preCmdName, constChars) THEN
  3728.             BEGIN
  3729.             IF (aCmdNumber = cNoCommand) | (aCmdNumber = cCantUndo) THEN
  3730.                 cmdName := ''
  3731.             ELSE
  3732.                 CmdToName(aCmdNumber, cmdName);
  3733.             IF SubstituteInTitle(undoName, cmdName, preCmdName, constChars) THEN;
  3734.             END;
  3735.  
  3736.         SetCmdName(cUndo, undoName);
  3737.  
  3738.         gUndoState := cmdDone;
  3739.         gUndoCmd := aCmdNumber;
  3740.         END;
  3741.     END;
  3742.  
  3743. {--------------------------------------------------------------------------------------------------}
  3744. {$S MAApplicationRes}
  3745.  
  3746. PROCEDURE TApplication.SetupTheMenus;
  3747.  
  3748.     PROCEDURE DoSetup;
  3749.  
  3750.         VAR
  3751.             appleMenu:            MenuHandle;
  3752.             undoState:            BOOLEAN;
  3753.             undoCmd:            CmdNumber;
  3754.             aWindow:            TWindow;
  3755.             lastCommand:        TCommand;
  3756.             lowSpace:            BOOLEAN;
  3757.  
  3758.         BEGIN
  3759.         IF NOT InModalMenuState THEN
  3760.             BEGIN
  3761.             {$IFC qInspector}
  3762.             lowSpace := MemSpaceIsLow;
  3763.             {$EndC}
  3764.  
  3765.             aWindow := GetActiveWindow;
  3766.             gGotClipType := FALSE;
  3767.  
  3768.             gTarget.DoSetupMenus;                        { Setup menus relevent to target chain }
  3769.  
  3770.             { Set up the menu commands that are not dependent on the target chain… }
  3771.  
  3772.             undoState := kShowCantUndo;                 { Set the Undo menu defaults. }
  3773.             undoCmd := cCantUndo;
  3774.             IF gSysWindowActive THEN
  3775.                 BEGIN
  3776.                 undoState := kShowUndo;
  3777.                 undoCmd := cNoCommand;
  3778.                 Enable(cUndo, TRUE);
  3779.                 Enable(cCut, TRUE);
  3780.                 Enable(cCopy, TRUE);
  3781.                 Enable(cPaste, TRUE);
  3782.                 Enable(cClear, TRUE);
  3783.                 END
  3784.             ELSE
  3785.                 BEGIN
  3786.                 lastCommand := gTarget.GetLastCommand;
  3787.                 IF lastCommand <> NIL THEN
  3788.                     WITH lastCommand DO
  3789.                         IF fCanUndo THEN
  3790.                             BEGIN
  3791.                             IF fCmdDone THEN
  3792.                                 undoState := kShowUndo
  3793.                             ELSE
  3794.                                 undoState := kShowRedo;
  3795.                             undoCmd := fCmdNumber;
  3796.  
  3797.               { Enable Undo only if the last command was not document-specific
  3798.                or the document changed is the current document. }
  3799.                             Enable(cUndo, (fChangedDocument = NIL) | ((aWindow <> NIL) &
  3800.                                    (fChangedDocument = aWindow.fDocument)));
  3801.                             END;
  3802.                 END;
  3803.             SetUndoText(undoState, undoCmd);
  3804.  
  3805.             {!!! we should really just make a call to the debugger/inspector here and give
  3806.             them a shot at setting these up instead }
  3807.             {$IFC qDebug}
  3808.             EnableCheck(cExperimenting, TRUE, gExperimenting);
  3809.             EnableCheck(cReportEvt, TRUE, gReportEvt);
  3810.             EnableCheck(cDebugPrinting, TRUE, gDebugPrinting);
  3811.             EnableCheck(cReportMenuChoices, TRUE, gReportMenuChoices);
  3812.             EnableCheck(cIntenseDebugging, TRUE, gIntenseDebugging);
  3813.             Enable(cIdentifySoftware, TRUE);
  3814.             Enable(cEnterMacAppDebugger, TRUE);
  3815.  
  3816.             IF aWindow <> NIL THEN
  3817.                 BEGIN
  3818.                 Enable(cModalToggle, TRUE);
  3819.                 SetMenuState(cModalToggle, kDebugBuzzStrings, bzMakeModal, bzMakeModeless,
  3820.                              aWindow.fIsModal);
  3821.                 Enable(cRefreshFrontWindow, TRUE);
  3822.                 Enable(cDoFirstClick, TRUE);
  3823.                 SetMenuState(cDoFirstClick, kDebugBuzzStrings, bzDoFirstClick, bzDontDoFirstClick,
  3824.                              aWindow.fDoFirstClick);
  3825.                 END;
  3826.  
  3827.             IF qNeedsROM128k | gConfiguration.hasROM128k THEN
  3828.                 BEGIN
  3829.                 Enable(cSetSysJust, TRUE);
  3830.                 SetMenuState(cSetSysJust, kDebugBuzzStrings, bzSetRightSysJust, bzSetLeftSysJust,
  3831.                              GetActualJustification(teJustSystem) <> teJustLeft);
  3832.                 END;
  3833.  
  3834.             EnableCheck(cTraceSetupMenus, TRUE, gTraceSetupMenus);
  3835.             EnableCheck(cTraceIdle, TRUE, gTraceIdle);
  3836.  
  3837.             Enable(cDebugWind, TRUE);
  3838.             {$ENDC}
  3839.  
  3840.             {$IFC qInspector}
  3841.             Enable(cNewInspectorWindow, NOT lowSpace);
  3842.             {$ENDC}
  3843.  
  3844.             IF NOT gSysWindowActive THEN
  3845.                 Enable(cPaste, gGotClipType);
  3846.             END;
  3847.  
  3848.         appleMenu := MAGetMenu(mApple);
  3849.         WITH appleMenu^^ DO
  3850.             IF Odd(enableFlags) = InModalState THEN
  3851.                 BEGIN
  3852.                 enableFlags := BXOR(enableFlags, 1);
  3853.                 InvalidateMenuBar;
  3854.                 END;
  3855.  
  3856.         END;
  3857.  
  3858.     BEGIN
  3859.     IF MenusHavePendingUpdate | MenuBarHasPendingUpdate THEN
  3860.         PerformMenuSetup(DoSetup);
  3861.     END;
  3862.  
  3863. {--------------------------------------------------------------------------------------------------}
  3864. {$S MAOpen}
  3865.  
  3866. PROCEDURE TApplication.SFGetParms(itsCmdNumber: CmdNumber;
  3867.                                   VAR dlgID: integer;
  3868.                                   VAR where: Point;
  3869.                                   VAR fileFilter, dlgHook, filterProc: ProcPtr;
  3870.                                   typeList: TypeListHandle);
  3871.  
  3872.     VAR
  3873.         dlogTemplate:        DialogTHndl;
  3874.         dialogRect:         Rect;
  3875.  
  3876.     BEGIN
  3877.     dlgID := getDlgID;
  3878.  
  3879.     { compute the top-left location of the dialog }
  3880.     dlogTemplate := DialogTHndl(GetResource('DLOG', dlgID));
  3881.     IF dlogTemplate <> NIL THEN
  3882.         BEGIN
  3883.         dialogRect := dlogTemplate^^.boundsRect;
  3884.         CenterRectOnScreen(dialogRect, TRUE, TRUE, TRUE);
  3885.         where := dialogRect.topLeft;
  3886.         END
  3887.     ELSE
  3888.         SetPt(where, 100, 100);
  3889.  
  3890.     fileFilter := NIL;
  3891.     dlgHook := NIL;
  3892.     filterProc := NIL;
  3893.     SetHandleSize(Handle(typeList), 4);
  3894.     FailMemError;
  3895.     typeList^^[1] := gMainFileType;
  3896.     END;
  3897.  
  3898. {--------------------------------------------------------------------------------------------------}
  3899. {$S MAError}
  3900.  
  3901. PROCEDURE TApplication.ShowError(error: OSErr;
  3902.                                  message: LONGINT);
  3903.  
  3904.     BEGIN
  3905.     ErrorAlert(error, message);
  3906.     END;
  3907.  
  3908. {--------------------------------------------------------------------------------------------------}
  3909. {$S MAApplicationRes}
  3910.  
  3911. PROCEDURE TApplication.SpaceIsLow;
  3912.  
  3913.     VAR
  3914.         now:                LONGINT;
  3915.  
  3916.     BEGIN
  3917.     IF gEventLevel = 1 THEN                             { Don't unload segs if nested event
  3918.                                                          handling}
  3919.         UnloadAllSegments;
  3920.  
  3921.     { Show 'space is low' alert only after ever gLowSpaceInterval ticks. }
  3922.     IF (gLowSpaceInterval > 0) & (NOT gInBackground) THEN
  3923.         BEGIN
  3924.         now := TickCount;
  3925.         IF now > gNextSpaceMsg THEN
  3926.             BEGIN
  3927.             gInhibitNestedHandling := TRUE;             { Don't tell em again from the alert }
  3928.             StdAlert(phSpaceIsLow);
  3929.             gNextSpaceMsg := now + gLowSpaceInterval;
  3930.             END;
  3931.         END;
  3932.     END;
  3933.  
  3934. {--------------------------------------------------------------------------------------------------}
  3935. {$S MAClipboard}
  3936.  
  3937. PROCEDURE TApplication.SwapClipViews;
  3938.  
  3939.     VAR
  3940.         tempClipView:        TView;
  3941.  
  3942.     BEGIN
  3943.     tempClipView := gClipUndoView;
  3944.     gClipUndoView := gClipView;
  3945.  
  3946.     IF tempClipView <> NIL THEN
  3947.         SetClipView(tempClipView)                        { Installs old Undo clipboard as current
  3948.                                                          clipboard }
  3949.         {$IFC qDebug}
  3950.     ELSE
  3951.         ProgramBreak('SwapClipViews finds undo clipboard was NIL')
  3952.         {$ENDC}
  3953.                      ;
  3954.     END;
  3955.  
  3956. {--------------------------------------------------------------------------------------------------}
  3957. {$S MAApplicationRes}
  3958.  
  3959. FUNCTION TApplication.TrackCursor: BOOLEAN;
  3960.  
  3961.     VAR
  3962.         globalMouse:        Point;
  3963.         localMouse:         Point;
  3964.         cursorIsSet:        BOOLEAN;
  3965.         aWMgrWindow:        WindowPtr;
  3966.         cursorWindow:        TWindow;
  3967.         cursorView:         TView;
  3968.         windowVPt:            VPoint;
  3969.         windowBounds:        Rect;
  3970.         r:                    Rect;
  3971.         haveCursorRgn:        BOOLEAN;
  3972.         theActiveWindow:    TWindow;
  3973.         oldPort:            GrafPtr;
  3974.  
  3975.     FUNCTION GetDesktopRect: Rect;
  3976.     { Returns the rgnBBox of the region representing the entire desktop (including menubar). }
  3977.  
  3978.         BEGIN
  3979.         {$IFC qDebug}
  3980.         UseTempRgn('TApplication.TrackCursor, GetDesktopRect');
  3981.         {$ENDC}
  3982.         IF qNeedsColorQD | gConfiguration.hasColorQD THEN { gTempRgn := main screen rect }
  3983.             RectRgn(gTempRgn, GetMainDevice^^.gdRect)
  3984.         ELSE
  3985.             RectRgn(gTempRgn, screenBits.bounds);
  3986.         UnionRgn(GetGrayRgn, gTempRgn, gTempRgn);        { gTempRgn := grayRgn + gTempRgn }
  3987.         GetDesktopRect := gTempRgn^^.rgnBBox;            { return bounding box }
  3988.         {$IFC qDebug}
  3989.         DoneWithTempRgn;
  3990.         {$ENDC}
  3991.         END;
  3992.  
  3993.     PROCEDURE CalcNotClaimedRgn;
  3994.     { Make the region wide open less the active window. And Less Any first click windows or DA's}
  3995.  
  3996.         PROCEDURE DoToWindow(theWMgrWindow: WindowPtr);
  3997.  
  3998.             VAR
  3999.                 aWindow:            TWindow;
  4000.  
  4001.             BEGIN
  4002.             aWindow := WMgrToWindow(theWMgrWindow);
  4003.             IF (aWindow <> NIL) & (aWindow.fDoFirstClick | aWindow.fIsActive) & aWindow.IsShown THEN
  4004.                 DiffRgn(gCursorRgn, WindowPeek(theWMgrWindow)^.contRgn, gCursorRgn);
  4005.             END;
  4006.  
  4007.         BEGIN
  4008.         IF cursorWindow <> NIL THEN
  4009.             WITH globalMouse DO
  4010.                 SetRectRgn(gCursorRgn, h, v, h + 1, v + 1)
  4011.         ELSE
  4012.             BEGIN
  4013.             r := GetDesktopRect;
  4014.             RectRgn(gCursorRgn, r);
  4015.             EachWMgrWindowDo(DoToWindow);
  4016.             { make sure mouse's current location is included }
  4017.             {$IFC qDebug}
  4018.             UseTempRgn('TApplication.TrackCursor, CalcNotClaimedRgn');
  4019.             {$ENDC}
  4020.             WITH globalMouse DO
  4021.                 SetRectRgn(gTempRgn, h, v, h + 1, v + 1);
  4022.             UnionRgn(gTempRgn, gCursorRgn, gCursorRgn);
  4023.             {$IFC qDebug}
  4024.             DoneWithTempRgn;
  4025.             {$ENDC}
  4026.             END;
  4027.         END;
  4028.  
  4029.     BEGIN
  4030.     TrackCursor := FALSE;
  4031.  
  4032.     IF gInBackground THEN
  4033.         EXIT(TrackCursor);
  4034.  
  4035.     GetMouse(globalMouse);
  4036.     LocalToGlobal(globalMouse);
  4037.  
  4038.     IF PtInRgn(globalMouse, gCursorRgn) THEN
  4039.         BEGIN
  4040.         {$IFC qDebug}
  4041.         IF gIntenseDebugging & gTraceIdle THEN
  4042.             Writeln('cursor is in cursor region');
  4043.         {$ENDC}
  4044.         IF NOT gAlwaysTrackCursor THEN
  4045.             EXIT(TrackCursor);
  4046.         END;
  4047.  
  4048.     InvalidateCursorRgn;
  4049.     haveCursorRgn := FALSE;
  4050.     cursorIsSet := FALSE;
  4051.  
  4052.  { Find out if the cursor is in a window.  If it is the window must be the
  4053.   front window or must handle first clicks.
  4054.   ??? Shouldn't the cursor testing be handed off to the window!!! }
  4055.  
  4056.     theActiveWindow := GetActiveWindow;
  4057.  
  4058.     IF (FindWindow(globalMouse, aWMgrWindow) = inContent) THEN
  4059.         BEGIN
  4060.         GetPort(oldPort);
  4061.         SetPort(aWMgrWindow);
  4062.         localMouse := globalMouse;
  4063.         GlobalToLocal(localMouse);
  4064.         SetPort(oldPort);
  4065.  
  4066.         cursorWindow := WMgrToWindow(aWMgrWindow);
  4067.         IF (NOT PtInRgn(localMouse, aWMgrWindow^.visRgn)) | ((cursorWindow <> NIL) &
  4068.            (cursorWindow <> theActiveWindow) & (NOT cursorWindow.fDoFirstClick)) THEN
  4069.             cursorWindow := NIL;
  4070.         END
  4071.     ELSE
  4072.         cursorWindow := NIL;
  4073.  
  4074.     IF cursorWindow <> NIL THEN
  4075.         BEGIN
  4076.         cursorWindow.GetGlobalBounds(windowBounds);
  4077.         windowVPt.h := globalMouse.h - windowBounds.left;
  4078.         windowVPt.v := globalMouse.v - windowBounds.top;
  4079.         cursorView := cursorWindow.HandleCursor(windowVPt, gCursorRgn);
  4080.         IF cursorView <> NIL THEN
  4081.             BEGIN
  4082.             cursorIsSet := TRUE;
  4083.  
  4084.             IF NOT EmptyRgn(gCursorRgn) THEN
  4085.                 BEGIN
  4086.                 haveCursorRgn := TRUE;
  4087.  
  4088.                 { Intersect with viewed rect }
  4089.                 IF qDebug THEN
  4090.                     cursorView.AssumeFocused;
  4091.  
  4092.                 { Intersect with visible region }
  4093.                 SectRgn(thePort^.visRgn, gCursorRgn, gCursorRgn);
  4094.                 SectRgn(thePort^.clipRgn, gCursorRgn, gCursorRgn);
  4095.  
  4096.                 { Convert gCursorRgn from view coords to global coords }
  4097.                 WITH thePort^.portRect DO
  4098.                     OffsetRgn(gCursorRgn, windowBounds.left - left, windowBounds.top - top);
  4099.                 END;
  4100.             END;
  4101.         END;
  4102.  
  4103.     IF NOT haveCursorRgn THEN
  4104.         CalcNotClaimedRgn;
  4105.  
  4106.     {$IFC qDebug}
  4107.     IF gIntenseDebugging & gTraceIdle THEN
  4108.         IF gCursorRgn = NIL THEN
  4109.             Writeln('gCursorRgn is NIL')
  4110.         ELSE
  4111.             BEGIN
  4112.             HLock(Handle(gCursorRgn));
  4113.             WrLblRect('gCursorRgn', gCursorRgn^^.rgnBBox);
  4114.             Writeln;
  4115.             HUnlock(Handle(gCursorRgn));
  4116.             END;
  4117.     {$ENDC}
  4118.  
  4119.     IF NOT cursorIsSet THEN
  4120.         SetCursor(arrow);
  4121.     TrackCursor := cursorIsSet;
  4122.  
  4123.     IF NOT PtInRgn(globalMouse, gCursorRgn) THEN
  4124.         BEGIN
  4125.         IF qDebug THEN
  4126.             BEGIN
  4127.             Writeln('Whoops, cursor region was not correctly calculated.');
  4128.             WrLblPt('global cursor', globalMouse);
  4129.             WrLblRect('  gCursorRgn^^.rgnBBox', gCursorRgn^^.rgnBBox);
  4130.             Writeln;
  4131.             ProgramBreak(
  4132.                         'The cursor is not in the cursor region at end of TApplication.TrackCursor!'
  4133.                          );
  4134.             END;
  4135.         END;
  4136.  
  4137.     END;
  4138.  
  4139. {--------------------------------------------------------------------------------------------------}
  4140. {$S MADoCommand}
  4141.  
  4142. FUNCTION TApplication.TrackMouse(globalMouse, hysteresis: Point;
  4143.                                  theCommand: TCommand): TCommand;
  4144.  
  4145.     VAR
  4146.         tracker:            TCommand;
  4147.         view:                TView;
  4148.         scroller:            TScroller;
  4149.         gotATracker:        BOOLEAN;
  4150.         theQDMouse:         Point;
  4151.         theMouse:            VPoint;
  4152.         anchorPoint:        VPoint;
  4153.         previousPoint:        VPoint;
  4154.         peekEvent:            EventRecord;
  4155.         movedOnce:            BOOLEAN;
  4156.         amtMoved:            VPoint;
  4157.         didMove:            BOOLEAN;
  4158.         delta:                VPoint;
  4159.         mouseInScroller:    VPoint;
  4160.         didScroll:            BOOLEAN;
  4161.         currTranslation:    VPoint;
  4162.         viewExtent:         VRect;
  4163.         autoscrollLimit:    VRect;
  4164.         focusedOnDesktop:    BOOLEAN;
  4165.         desktopPort:        CGrafPort;
  4166.         savedPort:            GrafPtr;
  4167.  
  4168.     PROCEDURE CleanUpFocus;
  4169.  
  4170.         BEGIN
  4171.         IF focusedOnDesktop THEN
  4172.             BEGIN
  4173.             IF qNeedsColorQD | gConfiguration.hasColorQD THEN
  4174.                 CloseCPort(@desktopPort)
  4175.             ELSE
  4176.                 ClosePort(@desktopPort);
  4177.             SetPort(savedPort);
  4178.             focusedOnDesktop := FALSE;
  4179.             END;
  4180.         END;
  4181.  
  4182.     PROCEDURE SetupFocus;
  4183.  
  4184.         BEGIN
  4185.         IF view <> NIL THEN
  4186.             BEGIN
  4187.             IF focusedOnDesktop THEN
  4188.                 CleanUpFocus;
  4189.  
  4190.             IF view.Focus THEN
  4191.                 BEGIN
  4192.                 GetFocus(gSaveFocusRec);
  4193.                 IF scroller <> NIL THEN
  4194.                     BEGIN
  4195.                     scroller.GetExtent(autoscrollLimit);
  4196.                     currTranslation := scroller.fTranslation;
  4197.                     END;
  4198.                 END
  4199.                 {$IFC qDebug}
  4200.             ELSE
  4201.                 ProgramBreak('TApplication.TrackMouse: Unable to focus view.')
  4202.                 {$ENDC}
  4203.                              ;
  4204.             END
  4205.         ELSE
  4206.             BEGIN                                        { focus on the desktop }
  4207.             IF NOT focusedOnDesktop THEN
  4208.                 BEGIN
  4209.                 GetPort(savedPort);                     { In case we exit still focusedOnDeskTop }
  4210.                 IF qNeedsColorQD | gConfiguration.hasColorQD THEN
  4211.                     OpenCPort(@desktopPort)
  4212.                 ELSE
  4213.                     OpenPort(@desktopPort);
  4214.                 focusedOnDesktop := TRUE;
  4215.                 END;
  4216.  
  4217.             CopyRgn(GetGrayRgn, desktopPort.visRgn);
  4218.             desktopPort.portRect := desktopPort.visRgn^^.rgnBBox;
  4219.             InvalidateFocus;
  4220.             GetFocus(gSaveFocusRec);
  4221.             END;
  4222.         END;
  4223.  
  4224.     PROCEDURE DoFocus;
  4225.  
  4226.         BEGIN
  4227.         {$Push} {$H-}
  4228.         IF (scroller <> NIL) & NOT EqualVPt(currTranslation, scroller.fTranslation) THEN
  4229.         {$Pop}
  4230.             SetupFocus
  4231.         ELSE
  4232.             SetFocus(gSaveFocusRec);
  4233.         END;
  4234.  
  4235.     PROCEDURE InstallTracker(newTracker: TCommand);
  4236.  
  4237.         BEGIN
  4238.         tracker := newTracker;
  4239.         gotATracker := (tracker <> NIL);
  4240.         IF gotATracker THEN
  4241.             BEGIN
  4242.             view := tracker.fView;
  4243.             scroller := tracker.fScroller;
  4244.             IF view <> NIL THEN
  4245.                 view.GetExtent(viewExtent);
  4246.             SetupFocus;
  4247.             END;
  4248.         END;
  4249.  
  4250.     PROCEDURE FeedbackOnce(turnItOn, mouseDidMove: BOOLEAN);
  4251.  
  4252.         BEGIN
  4253.         IF gotATracker THEN
  4254.             BEGIN
  4255.             PenNormal;
  4256.             PenMode(PatXOR);
  4257.             tracker.TrackFeedback(anchorPoint, previousPoint, turnItOn, mouseDidMove);
  4258.             END;
  4259.         END;
  4260.  
  4261.     PROCEDURE ConstrainOnce;                            { ??? fold this into TrackOnce ??? }
  4262.  
  4263.         BEGIN
  4264.         IF gotATracker THEN
  4265.             BEGIN
  4266.             IF tracker.fViewConstrain & (view <> NIL) THEN
  4267.                 PinVRect(viewExtent, theMouse);
  4268.             IF tracker.fConstrainsMouse THEN
  4269.                 tracker.TrackConstrain(anchorPoint, previousPoint, theMouse);
  4270.             END;
  4271.         END;
  4272.  
  4273.     PROCEDURE TrackOnce(aTrackPhase: TrackPhase;
  4274.                         didMouseMove: BOOLEAN);
  4275.  
  4276.         VAR
  4277.             newTracker:         TCommand;
  4278.  
  4279.         BEGIN
  4280.         {$IFC qDebug}
  4281.         IF tracker = NIL THEN
  4282.             BEGIN
  4283.             ProgramBreak('In TApplication.TrackMouse: tracker = NIL');
  4284.             tracker := NIL;
  4285.             gotATracker := FALSE;
  4286.             END;
  4287.         {$ENDC}
  4288.  
  4289.         IF gotATracker THEN
  4290.             BEGIN
  4291.             newTracker := tracker.TrackMouse(aTrackPhase, anchorPoint, previousPoint, theMouse,
  4292.                                              didMouseMove);
  4293.             IF newTracker <> tracker THEN
  4294.                 BEGIN
  4295.                 FreeIfObject(tracker);
  4296.                 tracker := NIL;
  4297.  
  4298.                 InstallTracker(newTracker);
  4299.                 END
  4300.             ELSE IF (newTracker <> NIL) & (newTracker.fView <> view) THEN
  4301.                 InstallTracker(newTracker);
  4302.             END;
  4303.         END;
  4304.  
  4305.     BEGIN
  4306.     focusedOnDesktop := FALSE;
  4307.     InstallTracker(theCommand);
  4308.  
  4309.     theQDMouse := globalMouse;
  4310.     IF view <> NIL THEN
  4311.         BEGIN
  4312.         GlobalToLocal(theQDMouse);
  4313.         view.QDToViewPt(theQDMouse, theMouse);
  4314.         END
  4315.     ELSE
  4316.         PtToVPt(theQDMouse, theMouse);
  4317.     anchorPoint := theMouse;
  4318.     previousPoint := theMouse;
  4319.  
  4320.     ConstrainOnce;
  4321.  
  4322.     anchorPoint := theMouse;
  4323.     previousPoint := theMouse;                            { in case Constrain changed the localPoint;
  4324.                                                          guarantee that all 3 are the same on
  4325.                                                          TrackPress }
  4326.  
  4327.     TrackOnce(trackPress, TRUE);
  4328.     previousPoint := theMouse;                            { in case TrackMouse changed nextPoint }
  4329.     FeedbackOnce(TRUE, TRUE);
  4330.  
  4331.     movedOnce := FALSE;
  4332.  
  4333.     WHILE gotATracker & NOT tracker.IsDoneTracking DO
  4334.         BEGIN
  4335.         DoFocus;
  4336.         GetMouse(theQDMouse);
  4337.         IF view <> NIL THEN
  4338.             view.QDToViewPt(theQDMouse, theMouse)
  4339.         ELSE
  4340.             PtToVPt(theQDMouse, theMouse);
  4341.  
  4342.         IF NOT movedOnce THEN
  4343.             BEGIN
  4344.             ConstrainOnce;                                { ensure that we are playing on a level
  4345.                                                          field. }
  4346.             amtMoved := theMouse;
  4347.             SubVPt(anchorPoint, amtMoved);
  4348.             IF (Abs(amtMoved.h) >= hysteresis.h) | (Abs(amtMoved.v) >= hysteresis.v) THEN
  4349.                 movedOnce := TRUE;
  4350.             END;
  4351.  
  4352.         delta := gZeroVPt;
  4353.         IF movedOnce | tracker.fTrackNonMovement THEN
  4354.             BEGIN
  4355.  
  4356.             { ??? Problems with this:
  4357.             delta might be non-zero but scrolling can't take place
  4358.             because it is pinned at the end of the view
  4359.             also might want some slop before scrolling ??? }
  4360.  
  4361.             IF (scroller <> NIL) & (view <> NIL) THEN
  4362.                 BEGIN
  4363.                 mouseInScroller := theMouse;
  4364.                 view.LocalToWindow(mouseInScroller);
  4365.                 scroller.WindowToLocal(mouseInScroller);
  4366.                 IF NOT PtInVRect(mouseInScroller, autoscrollLimit) THEN
  4367.                     BEGIN
  4368.                     scroller.AutoScroll(mouseInScroller, delta); { Get the amount to autoscroll, if any }
  4369.                     AddVPt(delta, theMouse);
  4370.                     END;
  4371.                 END;
  4372.  
  4373.             ConstrainOnce;
  4374.             END;
  4375.  
  4376.         didScroll := NOT EqualVPt(delta, gZeroVPt);
  4377.         didMove := NOT EqualVPt(previousPoint, theMouse);
  4378.  
  4379.         FeedbackOnce(FALSE, didMove | didScroll);
  4380.  
  4381.         IF didScroll THEN
  4382.             BEGIN
  4383.             tracker.AutoScroll(delta.h, delta.v);    { OK, now actually do the scrolling }
  4384.             IF view <> NIL THEN
  4385.                 view.Update;                        { Keep synchronized.  ScrollDraw only invalidated }
  4386.             SetupFocus;                                 { the focus changed }
  4387.             END;
  4388.  
  4389.         TrackOnce(trackMove, didMove);                    { ??? add OR didscroll ??? }
  4390.  
  4391.         previousPoint := theMouse;
  4392.         FeedbackOnce(TRUE, didMove | didScroll);
  4393.         END;
  4394.  
  4395.     DoFocus;
  4396.  
  4397.     IF NOT movedOnce THEN
  4398.         theMouse := previousPoint                        { normally same as original mouse down; we
  4399.                                                          don't use anchorPoint in case someone has
  4400.                                                          changed that -- it is more likely that an
  4401.                                                          app would change anchorPoint than
  4402.                                                          previousPoint }
  4403.  
  4404.     ELSE IF EventAvail(mUpMask + mDownMask, peekEvent) THEN
  4405.         BEGIN
  4406.         theQDMouse := peekEvent.where;
  4407.         IF view <> NIL THEN
  4408.             BEGIN
  4409.             GlobalToLocal(theQDMouse);
  4410.             view.QDToViewPt(theQDMouse, theMouse);
  4411.             END
  4412.         ELSE
  4413.             PtToVPt(theQDMouse, theMouse);
  4414.         ConstrainOnce;
  4415.         END;
  4416.     { ELSE we use the last known mouse position }
  4417.  
  4418.     FeedbackOnce(FALSE, TRUE);
  4419.     TrackOnce(trackRelease, TRUE);
  4420.  
  4421.     CleanUpFocus;
  4422.  
  4423.     TrackMouse := tracker;
  4424.  
  4425.     END;
  4426.  
  4427. {--------------------------------------------------------------------------------------------------}
  4428. {$S MAApplicationRes}
  4429.  
  4430. PROCEDURE TApplication.UpdateAllWindows;
  4431.  
  4432.     CONST
  4433.         systemEventMask     = app4Mask;                 { maybe this will be defined in the
  4434.                                                          interfaces someday }
  4435.  
  4436.     VAR
  4437.         anEvent:            EventRecord;
  4438.  
  4439.     BEGIN
  4440.     WHILE GetEvent(updateMask + activMask + systemEventMask, 0, NIL, anEvent) DO { SystemEvents
  4441.               aren't queued }
  4442.         HandleEvent(anEvent);
  4443.     END;
  4444.  
  4445. {--------------------------------------------------------------------------------------------------}
  4446. {$S MAApplicationRes}
  4447.  
  4448. FUNCTION TApplication.WMgrToWindow(aWMgrWindow: WindowPtr): TWindow;
  4449.  
  4450.     BEGIN
  4451.     IF (aWMgrWindow <> NIL) & (NOT IsDeskAccessory(aWMgrWindow))
  4452.     { Make an IsObject test too because some slimedog may have created a window in our
  4453.     world and the refcon wouldn't be an object.  Since this is the only place in
  4454.     MacApp that we get asked to do something to a ToolBox structure where we don't _know_
  4455.     that we created the structure we need to be especially careful here.  ??? Perhaps in the
  4456.     future we should use a dictionary to make the windowPtr to TWindow association for us. }
  4457.        & IsObject(GetWRefCon(aWMgrWindow)) THEN
  4458.         WMgrToWindow := TWindow(GetWRefCon(aWMgrWindow))
  4459.     ELSE
  4460.         WMgrToWindow := NIL;
  4461.     END;
  4462.